home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl / 5.10.0 / Math / BigFloat.pm next >
Encoding:
Perl POD Document  |  2009-06-26  |  126.3 KB  |  4,354 lines

  1. package Math::BigFloat;
  2.  
  3. # Mike grinned. 'Two down, infinity to go' - Mike Nostrus in 'Before and After'
  4. #
  5.  
  6. # The following hash values are internally used:
  7. #   _e    : exponent (ref to $CALC object)
  8. #   _m    : mantissa (ref to $CALC object)
  9. #   _es    : sign of _e
  10. # sign    : +,-,+inf,-inf, or "NaN" if not a number
  11. #   _a    : accuracy
  12. #   _p    : precision
  13.  
  14. $VERSION = '1.59';
  15. require 5.006;
  16.  
  17. require Exporter;
  18. @ISA        = qw/Math::BigInt/;
  19. @EXPORT_OK    = qw/bpi/;
  20.  
  21. use strict;
  22. # $_trap_inf/$_trap_nan are internal and should never be accessed from outside
  23. use vars qw/$AUTOLOAD $accuracy $precision $div_scale $round_mode $rnd_mode
  24.         $upgrade $downgrade $_trap_nan $_trap_inf/;
  25. my $class = "Math::BigFloat";
  26.  
  27. use overload
  28. '<=>'    =>    sub { my $rc = $_[2] ?
  29.                       ref($_[0])->bcmp($_[1],$_[0]) : 
  30.                       ref($_[0])->bcmp($_[0],$_[1]); 
  31.               $rc = 1 unless defined $rc;
  32.               $rc <=> 0;
  33.         },
  34. # we need '>=' to get things like "1 >= NaN" right:
  35. '>='    =>    sub { my $rc = $_[2] ?
  36.                       ref($_[0])->bcmp($_[1],$_[0]) : 
  37.                       ref($_[0])->bcmp($_[0],$_[1]);
  38.               # if there was a NaN involved, return false
  39.               return '' unless defined $rc;
  40.               $rc >= 0;
  41.         },
  42. 'int'    =>    sub { $_[0]->as_number() },        # 'trunc' to bigint
  43. ;
  44.  
  45. ##############################################################################
  46. # global constants, flags and assorted stuff
  47.  
  48. # the following are public, but their usage is not recommended. Use the
  49. # accessor methods instead.
  50.  
  51. # class constants, use Class->constant_name() to access
  52. # one of 'even', 'odd', '+inf', '-inf', 'zero', 'trunc' or 'common'
  53. $round_mode = 'even';
  54. $accuracy   = undef;
  55. $precision  = undef;
  56. $div_scale  = 40;
  57.  
  58. $upgrade = undef;
  59. $downgrade = undef;
  60. # the package we are using for our private parts, defaults to:
  61. # Math::BigInt->config()->{lib}
  62. my $MBI = 'Math::BigInt::FastCalc';
  63.  
  64. # are NaNs ok? (otherwise it dies when encountering an NaN) set w/ config()
  65. $_trap_nan = 0;
  66. # the same for infinity
  67. $_trap_inf = 0;
  68.  
  69. # constant for easier life
  70. my $nan = 'NaN'; 
  71.  
  72. my $IMPORT = 0;    # was import() called yet? used to make require work
  73.  
  74. # some digits of accuracy for blog(undef,10); which we use in blog() for speed
  75. my $LOG_10 = 
  76.  '2.3025850929940456840179914546843642076011014886287729760333279009675726097';
  77. my $LOG_10_A = length($LOG_10)-1;
  78. # ditto for log(2)
  79. my $LOG_2 = 
  80.  '0.6931471805599453094172321214581765680755001343602552541206800094933936220';
  81. my $LOG_2_A = length($LOG_2)-1;
  82. my $HALF = '0.5';            # made into an object if nec.
  83.  
  84. ##############################################################################
  85. # the old code had $rnd_mode, so we need to support it, too
  86.  
  87. sub TIESCALAR   { my ($class) = @_; bless \$round_mode, $class; }
  88. sub FETCH       { return $round_mode; }
  89. sub STORE       { $rnd_mode = $_[0]->round_mode($_[1]); }
  90.  
  91. BEGIN
  92.   {
  93.   # when someone sets $rnd_mode, we catch this and check the value to see
  94.   # whether it is valid or not. 
  95.   $rnd_mode   = 'even'; tie $rnd_mode, 'Math::BigFloat';
  96.  
  97.   # we need both of them in this package:
  98.   *as_int = \&as_number;
  99.   }
  100.  
  101. ##############################################################################
  102.  
  103. {
  104.   # valid method aliases for AUTOLOAD
  105.   my %methods = map { $_ => 1 }  
  106.    qw / fadd fsub fmul fdiv fround ffround fsqrt fmod fstr fsstr fpow fnorm
  107.         fint facmp fcmp fzero fnan finf finc fdec ffac fneg
  108.     fceil ffloor frsft flsft fone flog froot fexp
  109.       /;
  110.   # valid methods that can be handed up (for AUTOLOAD)
  111.   my %hand_ups = map { $_ => 1 }  
  112.    qw / is_nan is_inf is_negative is_positive is_pos is_neg
  113.         accuracy precision div_scale round_mode fabs fnot
  114.         objectify upgrade downgrade
  115.     bone binf bnan bzero
  116.     bsub
  117.       /;
  118.  
  119.   sub _method_alias { exists $methods{$_[0]||''}; } 
  120.   sub _method_hand_up { exists $hand_ups{$_[0]||''}; } 
  121. }
  122.  
  123. ##############################################################################
  124. # constructors
  125.  
  126. sub new 
  127.   {
  128.   # create a new BigFloat object from a string or another bigfloat object. 
  129.   # _e: exponent
  130.   # _m: mantissa
  131.   # sign  => sign (+/-), or "NaN"
  132.  
  133.   my ($class,$wanted,@r) = @_;
  134.  
  135.   # avoid numify-calls by not using || on $wanted!
  136.   return $class->bzero() if !defined $wanted;    # default to 0
  137.   return $wanted->copy() if UNIVERSAL::isa($wanted,'Math::BigFloat');
  138.  
  139.   $class->import() if $IMPORT == 0;             # make require work
  140.  
  141.   my $self = {}; bless $self, $class;
  142.   # shortcut for bigints and its subclasses
  143.   if ((ref($wanted)) && UNIVERSAL::can( $wanted, "as_number"))
  144.     {
  145.     $self->{_m} = $wanted->as_number()->{value}; # get us a bigint copy
  146.     $self->{_e} = $MBI->_zero();
  147.     $self->{_es} = '+';
  148.     $self->{sign} = $wanted->sign();
  149.     return $self->bnorm();
  150.     }
  151.   # else: got a string or something maskerading as number (with overload)
  152.  
  153.   # handle '+inf', '-inf' first
  154.   if ($wanted =~ /^[+-]?inf\z/)
  155.     {
  156.     return $downgrade->new($wanted) if $downgrade;
  157.  
  158.     $self->{sign} = $wanted;        # set a default sign for bstr()
  159.     return $self->binf($wanted);
  160.     }
  161.  
  162.   # shortcut for simple forms like '12' that neither have trailing nor leading
  163.   # zeros
  164.   if ($wanted =~ /^([+-]?)([1-9][0-9]*[1-9])$/)
  165.     {
  166.     $self->{_e} = $MBI->_zero();
  167.     $self->{_es} = '+';
  168.     $self->{sign} = $1 || '+';
  169.     $self->{_m} = $MBI->_new($2);
  170.     return $self->round(@r) if !$downgrade;
  171.     }
  172.  
  173.   my ($mis,$miv,$mfv,$es,$ev) = Math::BigInt::_split($wanted);
  174.   if (!ref $mis)
  175.     {
  176.     if ($_trap_nan)
  177.       {
  178.       require Carp;
  179.       Carp::croak ("$wanted is not a number initialized to $class");
  180.       }
  181.     
  182.     return $downgrade->bnan() if $downgrade;
  183.     
  184.     $self->{_e} = $MBI->_zero();
  185.     $self->{_es} = '+';
  186.     $self->{_m} = $MBI->_zero();
  187.     $self->{sign} = $nan;
  188.     }
  189.   else
  190.     {
  191.     # make integer from mantissa by adjusting exp, then convert to int
  192.     $self->{_e} = $MBI->_new($$ev);        # exponent
  193.     $self->{_es} = $$es || '+';
  194.     my $mantissa = "$$miv$$mfv";         # create mant.
  195.     $mantissa =~ s/^0+(\d)/$1/;            # strip leading zeros
  196.     $self->{_m} = $MBI->_new($mantissa);     # create mant.
  197.  
  198.     # 3.123E0 = 3123E-3, and 3.123E-2 => 3123E-5
  199.     if (CORE::length($$mfv) != 0)
  200.       {
  201.       my $len = $MBI->_new( CORE::length($$mfv));
  202.       ($self->{_e}, $self->{_es}) =
  203.     _e_sub ($self->{_e}, $len, $self->{_es}, '+');
  204.       }
  205.     # we can only have trailing zeros on the mantissa if $$mfv eq ''
  206.     else
  207.       {
  208.       # Use a regexp to count the trailing zeros in $$miv instead of _zeros()
  209.       # because that is faster, especially when _m is not stored in base 10.
  210.       my $zeros = 0; $zeros = CORE::length($1) if $$miv =~ /[1-9](0*)$/; 
  211.       if ($zeros != 0)
  212.         {
  213.         my $z = $MBI->_new($zeros);
  214.         # turn '120e2' into '12e3'
  215.         $MBI->_rsft ( $self->{_m}, $z, 10);
  216.         ($self->{_e}, $self->{_es}) =
  217.       _e_add ( $self->{_e}, $z, $self->{_es}, '+');
  218.         }
  219.       }
  220.     $self->{sign} = $$mis;
  221.  
  222.     # for something like 0Ey, set y to 1, and -0 => +0
  223.     # Check $$miv for being '0' and $$mfv eq '', because otherwise _m could not
  224.     # have become 0. That's faster than to call $MBI->_is_zero().
  225.     $self->{sign} = '+', $self->{_e} = $MBI->_one()
  226.      if $$miv eq '0' and $$mfv eq '';
  227.  
  228.     return $self->round(@r) if !$downgrade;
  229.     }
  230.   # if downgrade, inf, NaN or integers go down
  231.  
  232.   if ($downgrade && $self->{_es} eq '+')
  233.     {
  234.     if ($MBI->_is_zero( $self->{_e} ))
  235.       {
  236.       return $downgrade->new($$mis . $MBI->_str( $self->{_m} ));
  237.       }
  238.     return $downgrade->new($self->bsstr()); 
  239.     }
  240.   $self->bnorm()->round(@r);            # first normalize, then round
  241.   }
  242.  
  243. sub copy
  244.   {
  245.   # if two arguments, the first one is the class to "swallow" subclasses
  246.   if (@_ > 1)
  247.     {
  248.     my  $self = bless {
  249.     sign => $_[1]->{sign}, 
  250.     _es => $_[1]->{_es}, 
  251.     _m => $MBI->_copy($_[1]->{_m}),
  252.     _e => $MBI->_copy($_[1]->{_e}),
  253.     }, $_[0] if @_ > 1;
  254.  
  255.     $self->{_a} = $_[1]->{_a} if defined $_[1]->{_a};
  256.     $self->{_p} = $_[1]->{_p} if defined $_[1]->{_p};
  257.     return $self;
  258.     }
  259.  
  260.   my $self = bless {
  261.     sign => $_[0]->{sign}, 
  262.     _es => $_[0]->{_es}, 
  263.     _m => $MBI->_copy($_[0]->{_m}),
  264.     _e => $MBI->_copy($_[0]->{_e}),
  265.     }, ref($_[0]);
  266.  
  267.   $self->{_a} = $_[0]->{_a} if defined $_[0]->{_a};
  268.   $self->{_p} = $_[0]->{_p} if defined $_[0]->{_p};
  269.   $self;
  270.   }
  271.  
  272. sub _bnan
  273.   {
  274.   # used by parent class bone() to initialize number to NaN
  275.   my $self = shift;
  276.   
  277.   if ($_trap_nan)
  278.     {
  279.     require Carp;
  280.     my $class = ref($self);
  281.     Carp::croak ("Tried to set $self to NaN in $class\::_bnan()");
  282.     }
  283.  
  284.   $IMPORT=1;                    # call our import only once
  285.   $self->{_m} = $MBI->_zero();
  286.   $self->{_e} = $MBI->_zero();
  287.   $self->{_es} = '+';
  288.   }
  289.  
  290. sub _binf
  291.   {
  292.   # used by parent class bone() to initialize number to +-inf
  293.   my $self = shift;
  294.   
  295.   if ($_trap_inf)
  296.     {
  297.     require Carp;
  298.     my $class = ref($self);
  299.     Carp::croak ("Tried to set $self to +-inf in $class\::_binf()");
  300.     }
  301.  
  302.   $IMPORT=1;                    # call our import only once
  303.   $self->{_m} = $MBI->_zero();
  304.   $self->{_e} = $MBI->_zero();
  305.   $self->{_es} = '+';
  306.   }
  307.  
  308. sub _bone
  309.   {
  310.   # used by parent class bone() to initialize number to 1
  311.   my $self = shift;
  312.   $IMPORT=1;                    # call our import only once
  313.   $self->{_m} = $MBI->_one();
  314.   $self->{_e} = $MBI->_zero();
  315.   $self->{_es} = '+';
  316.   }
  317.  
  318. sub _bzero
  319.   {
  320.   # used by parent class bone() to initialize number to 0
  321.   my $self = shift;
  322.   $IMPORT=1;                    # call our import only once
  323.   $self->{_m} = $MBI->_zero();
  324.   $self->{_e} = $MBI->_one();
  325.   $self->{_es} = '+';
  326.   }
  327.  
  328. sub isa
  329.   {
  330.   my ($self,$class) = @_;
  331.   return if $class =~ /^Math::BigInt/;        # we aren't one of these
  332.   UNIVERSAL::isa($self,$class);
  333.   }
  334.  
  335. sub config
  336.   {
  337.   # return (later set?) configuration data as hash ref
  338.   my $class = shift || 'Math::BigFloat';
  339.  
  340.   if (@_ == 1 && ref($_[0]) ne 'HASH')
  341.     {
  342.     my $cfg = $class->SUPER::config();
  343.     return $cfg->{$_[0]};
  344.     }
  345.  
  346.   my $cfg = $class->SUPER::config(@_);
  347.  
  348.   # now we need only to override the ones that are different from our parent
  349.   $cfg->{class} = $class;
  350.   $cfg->{with} = $MBI;
  351.   $cfg;
  352.   }
  353.  
  354. ##############################################################################
  355. # string conversation
  356.  
  357. sub bstr 
  358.   {
  359.   # (ref to BFLOAT or num_str ) return num_str
  360.   # Convert number from internal format to (non-scientific) string format.
  361.   # internal format is always normalized (no leading zeros, "-0" => "+0")
  362.   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
  363.  
  364.   if ($x->{sign} !~ /^[+-]$/)
  365.     {
  366.     return $x->{sign} unless $x->{sign} eq '+inf';      # -inf, NaN
  367.     return 'inf';                                       # +inf
  368.     }
  369.  
  370.   my $es = '0'; my $len = 1; my $cad = 0; my $dot = '.';
  371.  
  372.   # $x is zero?
  373.   my $not_zero = !($x->{sign} eq '+' && $MBI->_is_zero($x->{_m}));
  374.   if ($not_zero)
  375.     {
  376.     $es = $MBI->_str($x->{_m});
  377.     $len = CORE::length($es);
  378.     my $e = $MBI->_num($x->{_e});    
  379.     $e = -$e if $x->{_es} eq '-';
  380.     if ($e < 0)
  381.       {
  382.       $dot = '';
  383.       # if _e is bigger than a scalar, the following will blow your memory
  384.       if ($e <= -$len)
  385.         {
  386.         my $r = abs($e) - $len;
  387.         $es = '0.'. ('0' x $r) . $es; $cad = -($len+$r);
  388.         }
  389.       else
  390.         {
  391.         substr($es,$e,0) = '.'; $cad = $MBI->_num($x->{_e});
  392.         $cad = -$cad if $x->{_es} eq '-';
  393.         }
  394.       }
  395.     elsif ($e > 0)
  396.       {
  397.       # expand with zeros
  398.       $es .= '0' x $e; $len += $e; $cad = 0;
  399.       }
  400.     } # if not zero
  401.  
  402.   $es = '-'.$es if $x->{sign} eq '-';
  403.   # if set accuracy or precision, pad with zeros on the right side
  404.   if ((defined $x->{_a}) && ($not_zero))
  405.     {
  406.     # 123400 => 6, 0.1234 => 4, 0.001234 => 4
  407.     my $zeros = $x->{_a} - $cad;        # cad == 0 => 12340
  408.     $zeros = $x->{_a} - $len if $cad != $len;
  409.     $es .= $dot.'0' x $zeros if $zeros > 0;
  410.     }
  411.   elsif ((($x->{_p} || 0) < 0))
  412.     {
  413.     # 123400 => 6, 0.1234 => 4, 0.001234 => 6
  414.     my $zeros = -$x->{_p} + $cad;
  415.     $es .= $dot.'0' x $zeros if $zeros > 0;
  416.     }
  417.   $es;
  418.   }
  419.  
  420. sub bsstr
  421.   {
  422.   # (ref to BFLOAT or num_str ) return num_str
  423.   # Convert number from internal format to scientific string format.
  424.   # internal format is always normalized (no leading zeros, "-0E0" => "+0E0")
  425.   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
  426.  
  427.   if ($x->{sign} !~ /^[+-]$/)
  428.     {
  429.     return $x->{sign} unless $x->{sign} eq '+inf';      # -inf, NaN
  430.     return 'inf';                                       # +inf
  431.     }
  432.   my $sep = 'e'.$x->{_es};
  433.   my $sign = $x->{sign}; $sign = '' if $sign eq '+';
  434.   $sign . $MBI->_str($x->{_m}) . $sep . $MBI->_str($x->{_e});
  435.   }
  436.     
  437. sub numify 
  438.   {
  439.   # Make a number from a BigFloat object
  440.   # simple return a string and let Perl's atoi()/atof() handle the rest
  441.   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
  442.   $x->bsstr(); 
  443.   }
  444.  
  445. ##############################################################################
  446. # public stuff (usually prefixed with "b")
  447.  
  448. sub bneg
  449.   {
  450.   # (BINT or num_str) return BINT
  451.   # negate number or make a negated number from string
  452.   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
  453.  
  454.   return $x if $x->modify('bneg');
  455.  
  456.   # for +0 dont negate (to have always normalized +0). Does nothing for 'NaN'
  457.   $x->{sign} =~ tr/+-/-+/ unless ($x->{sign} eq '+' && $MBI->_is_zero($x->{_m}));
  458.   $x;
  459.   }
  460.  
  461. # tels 2001-08-04 
  462. # XXX TODO this must be overwritten and return NaN for non-integer values
  463. # band(), bior(), bxor(), too
  464. #sub bnot
  465. #  {
  466. #  $class->SUPER::bnot($class,@_);
  467. #  }
  468.  
  469. sub bcmp 
  470.   {
  471.   # Compares 2 values.  Returns one of undef, <0, =0, >0. (suitable for sort)
  472.  
  473.   # set up parameters
  474.   my ($self,$x,$y) = (ref($_[0]),@_);
  475.   # objectify is costly, so avoid it
  476.   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
  477.     {
  478.     ($self,$x,$y) = objectify(2,@_);
  479.     }
  480.  
  481.   return $upgrade->bcmp($x,$y) if defined $upgrade &&
  482.     ((!$x->isa($self)) || (!$y->isa($self)));
  483.  
  484.   if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
  485.     {
  486.     # handle +-inf and NaN
  487.     return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
  488.     return 0 if ($x->{sign} eq $y->{sign}) && ($x->{sign} =~ /^[+-]inf$/);
  489.     return +1 if $x->{sign} eq '+inf';
  490.     return -1 if $x->{sign} eq '-inf';
  491.     return -1 if $y->{sign} eq '+inf';
  492.     return +1;
  493.     }
  494.  
  495.   # check sign for speed first
  496.   return 1 if $x->{sign} eq '+' && $y->{sign} eq '-';    # does also 0 <=> -y
  497.   return -1 if $x->{sign} eq '-' && $y->{sign} eq '+';    # does also -x <=> 0
  498.  
  499.   # shortcut 
  500.   my $xz = $x->is_zero();
  501.   my $yz = $y->is_zero();
  502.   return 0 if $xz && $yz;                # 0 <=> 0
  503.   return -1 if $xz && $y->{sign} eq '+';        # 0 <=> +y
  504.   return 1 if $yz && $x->{sign} eq '+';            # +x <=> 0
  505.  
  506.   # adjust so that exponents are equal
  507.   my $lxm = $MBI->_len($x->{_m});
  508.   my $lym = $MBI->_len($y->{_m});
  509.   # the numify somewhat limits our length, but makes it much faster
  510.   my ($xes,$yes) = (1,1);
  511.   $xes = -1 if $x->{_es} ne '+';
  512.   $yes = -1 if $y->{_es} ne '+';
  513.   my $lx = $lxm + $xes * $MBI->_num($x->{_e});
  514.   my $ly = $lym + $yes * $MBI->_num($y->{_e});
  515.   my $l = $lx - $ly; $l = -$l if $x->{sign} eq '-';
  516.   return $l <=> 0 if $l != 0;
  517.   
  518.   # lengths (corrected by exponent) are equal
  519.   # so make mantissa equal length by padding with zero (shift left)
  520.   my $diff = $lxm - $lym;
  521.   my $xm = $x->{_m};        # not yet copy it
  522.   my $ym = $y->{_m};
  523.   if ($diff > 0)
  524.     {
  525.     $ym = $MBI->_copy($y->{_m});
  526.     $ym = $MBI->_lsft($ym, $MBI->_new($diff), 10);
  527.     }
  528.   elsif ($diff < 0)
  529.     {
  530.     $xm = $MBI->_copy($x->{_m});
  531.     $xm = $MBI->_lsft($xm, $MBI->_new(-$diff), 10);
  532.     }
  533.   my $rc = $MBI->_acmp($xm,$ym);
  534.   $rc = -$rc if $x->{sign} eq '-';        # -124 < -123
  535.   $rc <=> 0;
  536.   }
  537.  
  538. sub bacmp 
  539.   {
  540.   # Compares 2 values, ignoring their signs. 
  541.   # Returns one of undef, <0, =0, >0. (suitable for sort)
  542.   
  543.   # set up parameters
  544.   my ($self,$x,$y) = (ref($_[0]),@_);
  545.   # objectify is costly, so avoid it
  546.   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
  547.     {
  548.     ($self,$x,$y) = objectify(2,@_);
  549.     }
  550.  
  551.   return $upgrade->bacmp($x,$y) if defined $upgrade &&
  552.     ((!$x->isa($self)) || (!$y->isa($self)));
  553.  
  554.   # handle +-inf and NaN's
  555.   if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/)
  556.     {
  557.     return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
  558.     return 0 if ($x->is_inf() && $y->is_inf());
  559.     return 1 if ($x->is_inf() && !$y->is_inf());
  560.     return -1;
  561.     }
  562.  
  563.   # shortcut 
  564.   my $xz = $x->is_zero();
  565.   my $yz = $y->is_zero();
  566.   return 0 if $xz && $yz;                # 0 <=> 0
  567.   return -1 if $xz && !$yz;                # 0 <=> +y
  568.   return 1 if $yz && !$xz;                # +x <=> 0
  569.  
  570.   # adjust so that exponents are equal
  571.   my $lxm = $MBI->_len($x->{_m});
  572.   my $lym = $MBI->_len($y->{_m});
  573.   my ($xes,$yes) = (1,1);
  574.   $xes = -1 if $x->{_es} ne '+';
  575.   $yes = -1 if $y->{_es} ne '+';
  576.   # the numify somewhat limits our length, but makes it much faster
  577.   my $lx = $lxm + $xes * $MBI->_num($x->{_e});
  578.   my $ly = $lym + $yes * $MBI->_num($y->{_e});
  579.   my $l = $lx - $ly;
  580.   return $l <=> 0 if $l != 0;
  581.   
  582.   # lengths (corrected by exponent) are equal
  583.   # so make mantissa equal-length by padding with zero (shift left)
  584.   my $diff = $lxm - $lym;
  585.   my $xm = $x->{_m};        # not yet copy it
  586.   my $ym = $y->{_m};
  587.   if ($diff > 0)
  588.     {
  589.     $ym = $MBI->_copy($y->{_m});
  590.     $ym = $MBI->_lsft($ym, $MBI->_new($diff), 10);
  591.     }
  592.   elsif ($diff < 0)
  593.     {
  594.     $xm = $MBI->_copy($x->{_m});
  595.     $xm = $MBI->_lsft($xm, $MBI->_new(-$diff), 10);
  596.     }
  597.   $MBI->_acmp($xm,$ym);
  598.   }
  599.  
  600. sub badd 
  601.   {
  602.   # add second arg (BFLOAT or string) to first (BFLOAT) (modifies first)
  603.   # return result as BFLOAT
  604.  
  605.   # set up parameters
  606.   my ($self,$x,$y,@r) = (ref($_[0]),@_);
  607.   # objectify is costly, so avoid it
  608.   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
  609.     {
  610.     ($self,$x,$y,@r) = objectify(2,@_);
  611.     }
  612.  
  613.   return $x if $x->modify('badd');
  614.  
  615.   # inf and NaN handling
  616.   if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
  617.     {
  618.     # NaN first
  619.     return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
  620.     # inf handling
  621.     if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
  622.       {
  623.       # +inf++inf or -inf+-inf => same, rest is NaN
  624.       return $x if $x->{sign} eq $y->{sign};
  625.       return $x->bnan();
  626.       }
  627.     # +-inf + something => +inf; something +-inf => +-inf
  628.     $x->{sign} = $y->{sign}, return $x if $y->{sign} =~ /^[+-]inf$/;
  629.     return $x;
  630.     }
  631.  
  632.   return $upgrade->badd($x,$y,@r) if defined $upgrade &&
  633.    ((!$x->isa($self)) || (!$y->isa($self)));
  634.  
  635.   $r[3] = $y;                        # no push!
  636.  
  637.   # speed: no add for 0+y or x+0
  638.   return $x->bround(@r) if $y->is_zero();        # x+0
  639.   if ($x->is_zero())                    # 0+y
  640.     {
  641.     # make copy, clobbering up x (modify in place!)
  642.     $x->{_e} = $MBI->_copy($y->{_e});
  643.     $x->{_es} = $y->{_es};
  644.     $x->{_m} = $MBI->_copy($y->{_m});
  645.     $x->{sign} = $y->{sign} || $nan;
  646.     return $x->round(@r);
  647.     }
  648.  
  649.   # take lower of the two e's and adapt m1 to it to match m2
  650.   my $e = $y->{_e};
  651.   $e = $MBI->_zero() if !defined $e;        # if no BFLOAT?
  652.   $e = $MBI->_copy($e);                # make copy (didn't do it yet)
  653.  
  654.   my $es;
  655.  
  656.   ($e,$es) = _e_sub($e, $x->{_e}, $y->{_es} || '+', $x->{_es});
  657.  
  658.   my $add = $MBI->_copy($y->{_m});
  659.  
  660.   if ($es eq '-')                # < 0
  661.     {
  662.     $MBI->_lsft( $x->{_m}, $e, 10);
  663.     ($x->{_e},$x->{_es}) = _e_add($x->{_e}, $e, $x->{_es}, $es);
  664.     }
  665.   elsif (!$MBI->_is_zero($e))            # > 0
  666.     {
  667.     $MBI->_lsft($add, $e, 10);
  668.     }
  669.   # else: both e are the same, so just leave them
  670.  
  671.   if ($x->{sign} eq $y->{sign})
  672.     {
  673.     # add
  674.     $x->{_m} = $MBI->_add($x->{_m}, $add);
  675.     }
  676.   else
  677.     {
  678.     ($x->{_m}, $x->{sign}) = 
  679.      _e_add($x->{_m}, $add, $x->{sign}, $y->{sign});
  680.     }
  681.  
  682.   # delete trailing zeros, then round
  683.   $x->bnorm()->round(@r);
  684.   }
  685.  
  686. # sub bsub is inherited from Math::BigInt!
  687.  
  688. sub binc
  689.   {
  690.   # increment arg by one
  691.   my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
  692.  
  693.   return $x if $x->modify('binc');
  694.  
  695.   if ($x->{_es} eq '-')
  696.     {
  697.     return $x->badd($self->bone(),@r);    #  digits after dot
  698.     }
  699.  
  700.   if (!$MBI->_is_zero($x->{_e}))        # _e == 0 for NaN, inf, -inf
  701.     {
  702.     # 1e2 => 100, so after the shift below _m has a '0' as last digit
  703.     $x->{_m} = $MBI->_lsft($x->{_m}, $x->{_e},10);    # 1e2 => 100
  704.     $x->{_e} = $MBI->_zero();                # normalize
  705.     $x->{_es} = '+';
  706.     # we know that the last digit of $x will be '1' or '9', depending on the
  707.     # sign
  708.     }
  709.   # now $x->{_e} == 0
  710.   if ($x->{sign} eq '+')
  711.     {
  712.     $MBI->_inc($x->{_m});
  713.     return $x->bnorm()->bround(@r);
  714.     }
  715.   elsif ($x->{sign} eq '-')
  716.     {
  717.     $MBI->_dec($x->{_m});
  718.     $x->{sign} = '+' if $MBI->_is_zero($x->{_m}); # -1 +1 => -0 => +0
  719.     return $x->bnorm()->bround(@r);
  720.     }
  721.   # inf, nan handling etc
  722.   $x->badd($self->bone(),@r);            # badd() does round 
  723.   }
  724.  
  725. sub bdec
  726.   {
  727.   # decrement arg by one
  728.   my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
  729.  
  730.   return $x if $x->modify('bdec');
  731.  
  732.   if ($x->{_es} eq '-')
  733.     {
  734.     return $x->badd($self->bone('-'),@r);    #  digits after dot
  735.     }
  736.  
  737.   if (!$MBI->_is_zero($x->{_e}))
  738.     {
  739.     $x->{_m} = $MBI->_lsft($x->{_m}, $x->{_e},10);    # 1e2 => 100
  740.     $x->{_e} = $MBI->_zero();                # normalize
  741.     $x->{_es} = '+';
  742.     }
  743.   # now $x->{_e} == 0
  744.   my $zero = $x->is_zero();
  745.   # <= 0
  746.   if (($x->{sign} eq '-') || $zero)
  747.     {
  748.     $MBI->_inc($x->{_m});
  749.     $x->{sign} = '-' if $zero;                # 0 => 1 => -1
  750.     $x->{sign} = '+' if $MBI->_is_zero($x->{_m});    # -1 +1 => -0 => +0
  751.     return $x->bnorm()->round(@r);
  752.     }
  753.   # > 0
  754.   elsif ($x->{sign} eq '+')
  755.     {
  756.     $MBI->_dec($x->{_m});
  757.     return $x->bnorm()->round(@r);
  758.     }
  759.   # inf, nan handling etc
  760.   $x->badd($self->bone('-'),@r);        # does round
  761.   } 
  762.  
  763. sub DEBUG () { 0; }
  764.  
  765. sub blog
  766.   {
  767.   my ($self,$x,$base,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
  768.  
  769.   return $x if $x->modify('blog');
  770.  
  771.   # $base > 0, $base != 1; if $base == undef default to $base == e
  772.   # $x >= 0
  773.  
  774.   # we need to limit the accuracy to protect against overflow
  775.   my $fallback = 0;
  776.   my ($scale,@params);
  777.   ($x,@params) = $x->_find_round_parameters($a,$p,$r);
  778.  
  779.   # also takes care of the "error in _find_round_parameters?" case
  780.   return $x->bnan() if $x->{sign} ne '+' || $x->is_zero();
  781.  
  782.   # no rounding at all, so must use fallback
  783.   if (scalar @params == 0)
  784.     {
  785.     # simulate old behaviour
  786.     $params[0] = $self->div_scale();    # and round to it as accuracy
  787.     $params[1] = undef;            # P = undef
  788.     $scale = $params[0]+4;         # at least four more for proper round
  789.     $params[2] = $r;            # round mode by caller or undef
  790.     $fallback = 1;            # to clear a/p afterwards
  791.     }
  792.   else
  793.     {
  794.     # the 4 below is empirical, and there might be cases where it is not
  795.     # enough...
  796.     $scale = abs($params[0] || $params[1]) + 4;    # take whatever is defined
  797.     }
  798.  
  799.   return $x->bzero(@params) if $x->is_one();
  800.   # base not defined => base == Euler's number e
  801.   if (defined $base)
  802.     {
  803.     # make object, since we don't feed it through objectify() to still get the
  804.     # case of $base == undef
  805.     $base = $self->new($base) unless ref($base);
  806.     # $base > 0; $base != 1
  807.     return $x->bnan() if $base->is_zero() || $base->is_one() ||
  808.       $base->{sign} ne '+';
  809.     # if $x == $base, we know the result must be 1.0
  810.     if ($x->bcmp($base) == 0)
  811.       {
  812.       $x->bone('+',@params);
  813.       if ($fallback)
  814.         {
  815.         # clear a/p after round, since user did not request it
  816.         delete $x->{_a}; delete $x->{_p};
  817.         }
  818.       return $x;
  819.       }
  820.     }
  821.  
  822.   # when user set globals, they would interfere with our calculation, so
  823.   # disable them and later re-enable them
  824.   no strict 'refs';
  825.   my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef;
  826.   my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef;
  827.   # we also need to disable any set A or P on $x (_find_round_parameters took
  828.   # them already into account), since these would interfere, too
  829.   delete $x->{_a}; delete $x->{_p};
  830.   # need to disable $upgrade in BigInt, to avoid deep recursion
  831.   local $Math::BigInt::upgrade = undef;
  832.   local $Math::BigFloat::downgrade = undef;
  833.  
  834.   # upgrade $x if $x is not a BigFloat (handle BigInt input)
  835.   # XXX TODO: rebless!
  836.   if (!$x->isa('Math::BigFloat'))
  837.     {
  838.     $x = Math::BigFloat->new($x);
  839.     $self = ref($x);
  840.     }
  841.   
  842.   my $done = 0;
  843.  
  844.   # If the base is defined and an integer, try to calculate integer result
  845.   # first. This is very fast, and in case the real result was found, we can
  846.   # stop right here.
  847.   if (defined $base && $base->is_int() && $x->is_int())
  848.     {
  849.     my $i = $MBI->_copy( $x->{_m} );
  850.     $MBI->_lsft( $i, $x->{_e}, 10 ) unless $MBI->_is_zero($x->{_e});
  851.     my $int = Math::BigInt->bzero();
  852.     $int->{value} = $i;
  853.     $int->blog($base->as_number());
  854.     # if ($exact)
  855.     if ($base->as_number()->bpow($int) == $x)
  856.       {
  857.       # found result, return it
  858.       $x->{_m} = $int->{value};
  859.       $x->{_e} = $MBI->_zero();
  860.       $x->{_es} = '+';
  861.       $x->bnorm();
  862.       $done = 1;
  863.       }
  864.     }
  865.  
  866.   if ($done == 0)
  867.     {
  868.     # base is undef, so base should be e (Euler's number), so first calculate the
  869.     # log to base e (using reduction by 10 (and probably 2)):
  870.     $self->_log_10($x,$scale);
  871.  
  872.     # and if a different base was requested, convert it
  873.     if (defined $base)
  874.       {
  875.       $base = Math::BigFloat->new($base) unless $base->isa('Math::BigFloat');
  876.       # not ln, but some other base (don't modify $base)
  877.       $x->bdiv( $base->copy()->blog(undef,$scale), $scale );
  878.       }
  879.     }
  880.  
  881.   # shortcut to not run through _find_round_parameters again
  882.   if (defined $params[0])
  883.     {
  884.     $x->bround($params[0],$params[2]);        # then round accordingly
  885.     }
  886.   else
  887.     {
  888.     $x->bfround($params[1],$params[2]);        # then round accordingly
  889.     }
  890.   if ($fallback)
  891.     {
  892.     # clear a/p after round, since user did not request it
  893.     delete $x->{_a}; delete $x->{_p};
  894.     }
  895.   # restore globals
  896.   $$abr = $ab; $$pbr = $pb;
  897.  
  898.   $x;
  899.   }
  900.  
  901. sub _len_to_steps
  902.   {
  903.   # Given D (digits in decimal), compute N so that N! (N factorial) is
  904.   # at least D digits long. D should be at least 50.
  905.   my $d = shift;
  906.  
  907.   # two constants for the Ramanujan estimate of ln(N!)
  908.   my $lg2 = log(2 * 3.14159265) / 2;
  909.   my $lg10 = log(10);
  910.  
  911.   # D = 50 => N => 42, so L = 40 and R = 50
  912.   my $l = 40; my $r = $d;
  913.  
  914.   # Otherwise this does not work under -Mbignum and we do not yet have "no bignum;" :(
  915.   $l = $l->numify if ref($l);
  916.   $r = $r->numify if ref($r);
  917.   $lg2 = $lg2->numify if ref($lg2);
  918.   $lg10 = $lg10->numify if ref($lg10);
  919.  
  920.   # binary search for the right value (could this be written as the reverse of lg(n!)?)
  921.   while ($r - $l > 1)
  922.     {
  923.     my $n = int(($r - $l) / 2) + $l;
  924.     my $ramanujan = 
  925.       int(($n * log($n) - $n + log( $n * (1 + 4*$n*(1+2*$n)) ) / 6 + $lg2) / $lg10);
  926.     $ramanujan > $d ? $r = $n : $l = $n;
  927.     }
  928.   $l;
  929.   }
  930.  
  931. sub bnok
  932.   {
  933.   # Calculate n over k (binomial coefficient or "choose" function) as integer.
  934.   # set up parameters
  935.   my ($self,$x,$y,@r) = (ref($_[0]),@_);
  936.  
  937.   # objectify is costly, so avoid it
  938.   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
  939.     {
  940.     ($self,$x,$y,@r) = objectify(2,@_);
  941.     }
  942.  
  943.   return $x if $x->modify('bnok');
  944.  
  945.   return $x->bnan() if $x->is_nan() || $y->is_nan();
  946.   return $x->binf() if $x->is_inf();
  947.  
  948.   my $u = $x->as_int();
  949.   $u->bnok($y->as_int());
  950.  
  951.   $x->{_m} = $u->{value};
  952.   $x->{_e} = $MBI->_zero();
  953.   $x->{_es} = '+';
  954.   $x->{sign} = '+';
  955.   $x->bnorm(@r);
  956.   }
  957.  
  958. sub bexp
  959.   {
  960.   # Calculate e ** X (Euler's number to the power of X)
  961.   my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
  962.  
  963.   return $x if $x->modify('bexp');
  964.  
  965.   return $x->binf() if $x->{sign} eq '+inf';
  966.   return $x->bzero() if $x->{sign} eq '-inf';
  967.  
  968.   # we need to limit the accuracy to protect against overflow
  969.   my $fallback = 0;
  970.   my ($scale,@params);
  971.   ($x,@params) = $x->_find_round_parameters($a,$p,$r);
  972.  
  973.   # also takes care of the "error in _find_round_parameters?" case
  974.   return $x if $x->{sign} eq 'NaN';
  975.  
  976.   # no rounding at all, so must use fallback
  977.   if (scalar @params == 0)
  978.     {
  979.     # simulate old behaviour
  980.     $params[0] = $self->div_scale();    # and round to it as accuracy
  981.     $params[1] = undef;            # P = undef
  982.     $scale = $params[0]+4;         # at least four more for proper round
  983.     $params[2] = $r;            # round mode by caller or undef
  984.     $fallback = 1;            # to clear a/p afterwards
  985.     }
  986.   else
  987.     {
  988.     # the 4 below is empirical, and there might be cases where it's not enough...
  989.     $scale = abs($params[0] || $params[1]) + 4;    # take whatever is defined
  990.     }
  991.  
  992.   return $x->bone(@params) if $x->is_zero();
  993.  
  994.   if (!$x->isa('Math::BigFloat'))
  995.     {
  996.     $x = Math::BigFloat->new($x);
  997.     $self = ref($x);
  998.     }
  999.   
  1000.   # when user set globals, they would interfere with our calculation, so
  1001.   # disable them and later re-enable them
  1002.   no strict 'refs';
  1003.   my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef;
  1004.   my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef;
  1005.   # we also need to disable any set A or P on $x (_find_round_parameters took
  1006.   # them already into account), since these would interfere, too
  1007.   delete $x->{_a}; delete $x->{_p};
  1008.   # need to disable $upgrade in BigInt, to avoid deep recursion
  1009.   local $Math::BigInt::upgrade = undef;
  1010.   local $Math::BigFloat::downgrade = undef;
  1011.  
  1012.   my $x_org = $x->copy();
  1013.  
  1014.   # We use the following Taylor series:
  1015.  
  1016.   #           x    x^2   x^3   x^4
  1017.   #  e = 1 + --- + --- + --- + --- ...
  1018.   #           1!    2!    3!    4!
  1019.  
  1020.   # The difference for each term is X and N, which would result in:
  1021.   # 2 copy, 2 mul, 2 add, 1 inc, 1 div operations per term
  1022.  
  1023.   # But it is faster to compute exp(1) and then raising it to the
  1024.   # given power, esp. if $x is really big and an integer because:
  1025.  
  1026.   #  * The numerator is always 1, making the computation faster
  1027.   #  * the series converges faster in the case of x == 1
  1028.   #  * We can also easily check when we have reached our limit: when the
  1029.   #    term to be added is smaller than "1E$scale", we can stop - f.i.
  1030.   #    scale == 5, and we have 1/40320, then we stop since 1/40320 < 1E-5.
  1031.   #  * we can compute the *exact* result by simulating bigrat math:
  1032.  
  1033.   #  1   1    gcd(3,4) = 1    1*24 + 1*6    5
  1034.   #  - + -                  = ---------- =  --                 
  1035.   #  6   24                      6*24       24
  1036.  
  1037.   # We do not compute the gcd() here, but simple do:
  1038.   #  1   1    1*24 + 1*6   30
  1039.   #  - + -  = --------- =  --                 
  1040.   #  6   24       6*24     144
  1041.  
  1042.   # In general:
  1043.   #  a   c    a*d + c*b     and note that c is always 1 and d = (b*f)
  1044.   #  - + -  = ---------
  1045.   #  b   d       b*d
  1046.  
  1047.   # This leads to:         which can be reduced by b to:
  1048.   #  a   1     a*b*f + b    a*f + 1
  1049.   #  - + -   = --------- =  -------
  1050.   #  b   b*f     b*b*f        b*f
  1051.  
  1052.   # The first terms in the series are:
  1053.  
  1054.   # 1     1    1    1    1    1     1     1     13700
  1055.   # -- + -- + -- + -- + -- + --- + --- + ---- = -----
  1056.   # 1     1    2    6   24   120   720   5040   5040
  1057.  
  1058.   # Note that we cannot simple reduce 13700/5040 to 685/252, but must keep A and B!
  1059.  
  1060.   if ($scale <= 75)
  1061.     {
  1062.     # set $x directly from a cached string form
  1063.     $x->{_m} = $MBI->_new(
  1064.     "27182818284590452353602874713526624977572470936999595749669676277240766303535476");
  1065.     $x->{sign} = '+';
  1066.     $x->{_es} = '-';
  1067.     $x->{_e} = $MBI->_new(79);
  1068.     }
  1069.   else
  1070.     {
  1071.     # compute A and B so that e = A / B.
  1072.  
  1073.     # After some terms we end up with this, so we use it as a starting point:
  1074.     my $A = $MBI->_new("90933395208605785401971970164779391644753259799242");
  1075.     my $F = $MBI->_new(42); my $step = 42;
  1076.  
  1077.     # Compute how many steps we need to take to get $A and $B sufficiently big
  1078.     my $steps = _len_to_steps($scale - 4);
  1079. #    print STDERR "# Doing $steps steps for ", $scale-4, " digits\n";
  1080.     while ($step++ <= $steps)
  1081.       {
  1082.       # calculate $a * $f + 1
  1083.       $A = $MBI->_mul($A, $F);
  1084.       $A = $MBI->_inc($A);
  1085.       # increment f
  1086.       $F = $MBI->_inc($F);
  1087.       }
  1088.     # compute $B as factorial of $steps (this is faster than doing it manually)
  1089.     my $B = $MBI->_fac($MBI->_new($steps));
  1090.     
  1091. #  print "A ", $MBI->_str($A), "\nB ", $MBI->_str($B), "\n";
  1092.  
  1093.     # compute A/B with $scale digits in the result (truncate, not round)
  1094.     $A = $MBI->_lsft( $A, $MBI->_new($scale), 10);
  1095.     $A = $MBI->_div( $A, $B );
  1096.  
  1097.     $x->{_m} = $A;
  1098.     $x->{sign} = '+';
  1099.     $x->{_es} = '-';
  1100.     $x->{_e} = $MBI->_new($scale);
  1101.     }
  1102.  
  1103.   # $x contains now an estimate of e, with some surplus digits, so we can round
  1104.   if (!$x_org->is_one())
  1105.     {
  1106.     # raise $x to the wanted power and round it in one step:
  1107.     $x->bpow($x_org, @params);
  1108.     }
  1109.   else
  1110.     {
  1111.     # else just round the already computed result
  1112.     delete $x->{_a}; delete $x->{_p};
  1113.     # shortcut to not run through _find_round_parameters again
  1114.     if (defined $params[0])
  1115.       {
  1116.       $x->bround($params[0],$params[2]);        # then round accordingly
  1117.       }
  1118.     else
  1119.       {
  1120.       $x->bfround($params[1],$params[2]);        # then round accordingly
  1121.       }
  1122.     }
  1123.   if ($fallback)
  1124.     {
  1125.     # clear a/p after round, since user did not request it
  1126.     delete $x->{_a}; delete $x->{_p};
  1127.     }
  1128.   # restore globals
  1129.   $$abr = $ab; $$pbr = $pb;
  1130.  
  1131.   $x;                        # return modified $x
  1132.   }
  1133.  
  1134. sub _log
  1135.   {
  1136.   # internal log function to calculate ln() based on Taylor series.
  1137.   # Modifies $x in place.
  1138.   my ($self,$x,$scale) = @_;
  1139.  
  1140.   # in case of $x == 1, result is 0
  1141.   return $x->bzero() if $x->is_one();
  1142.  
  1143.   # XXX TODO: rewrite this in a similiar manner to bexp()
  1144.  
  1145.   # http://www.efunda.com/math/taylor_series/logarithmic.cfm?search_string=log
  1146.  
  1147.   # u = x-1, v = x+1
  1148.   #              _                               _
  1149.   # Taylor:     |    u    1   u^3   1   u^5       |
  1150.   # ln (x)  = 2 |   --- + - * --- + - * --- + ... |  x > 0
  1151.   #             |_   v    3   v^3   5   v^5      _|
  1152.  
  1153.   # This takes much more steps to calculate the result and is thus not used
  1154.   # u = x-1
  1155.   #              _                               _
  1156.   # Taylor:     |    u    1   u^2   1   u^3       |
  1157.   # ln (x)  = 2 |   --- + - * --- + - * --- + ... |  x > 1/2
  1158.   #             |_   x    2   x^2   3   x^3      _|
  1159.  
  1160.   my ($limit,$v,$u,$below,$factor,$two,$next,$over,$f);
  1161.  
  1162.   $v = $x->copy(); $v->binc();        # v = x+1
  1163.   $x->bdec(); $u = $x->copy();        # u = x-1; x = x-1
  1164.   $x->bdiv($v,$scale);            # first term: u/v
  1165.   $below = $v->copy();
  1166.   $over = $u->copy();
  1167.   $u *= $u; $v *= $v;                # u^2, v^2
  1168.   $below->bmul($v);                # u^3, v^3
  1169.   $over->bmul($u);
  1170.   $factor = $self->new(3); $f = $self->new(2);
  1171.  
  1172.   my $steps = 0 if DEBUG;  
  1173.   $limit = $self->new("1E-". ($scale-1));
  1174.   while (3 < 5)
  1175.     {
  1176.     # we calculate the next term, and add it to the last
  1177.     # when the next term is below our limit, it won't affect the outcome
  1178.     # anymore, so we stop
  1179.  
  1180.     # calculating the next term simple from over/below will result in quite
  1181.     # a time hog if the input has many digits, since over and below will
  1182.     # accumulate more and more digits, and the result will also have many
  1183.     # digits, but in the end it is rounded to $scale digits anyway. So if we
  1184.     # round $over and $below first, we save a lot of time for the division
  1185.     # (not with log(1.2345), but try log (123**123) to see what I mean. This
  1186.     # can introduce a rounding error if the division result would be f.i.
  1187.     # 0.1234500000001 and we round it to 5 digits it would become 0.12346, but
  1188.     # if we truncated $over and $below we might get 0.12345. Does this matter
  1189.     # for the end result? So we give $over and $below 4 more digits to be
  1190.     # on the safe side (unscientific error handling as usual... :+D
  1191.  
  1192.     $next = $over->copy->bround($scale+4)->bdiv(
  1193.       $below->copy->bmul($factor)->bround($scale+4), 
  1194.       $scale);
  1195.  
  1196. ## old version:    
  1197. ##    $next = $over->copy()->bdiv($below->copy()->bmul($factor),$scale);
  1198.  
  1199.     last if $next->bacmp($limit) <= 0;
  1200.  
  1201.     delete $next->{_a}; delete $next->{_p};
  1202.     $x->badd($next);
  1203.     # calculate things for the next term
  1204.     $over *= $u; $below *= $v; $factor->badd($f);
  1205.     if (DEBUG)
  1206.       {
  1207.       $steps++; print "step $steps = $x\n" if $steps % 10 == 0;
  1208.       }
  1209.     }
  1210.   print "took $steps steps\n" if DEBUG;
  1211.   $x->bmul($f);                    # $x *= 2
  1212.   }
  1213.  
  1214. sub _log_10
  1215.   {
  1216.   # Internal log function based on reducing input to the range of 0.1 .. 9.99
  1217.   # and then "correcting" the result to the proper one. Modifies $x in place.
  1218.   my ($self,$x,$scale) = @_;
  1219.  
  1220.   # Taking blog() from numbers greater than 10 takes a *very long* time, so we
  1221.   # break the computation down into parts based on the observation that:
  1222.   #  blog(X*Y) = blog(X) + blog(Y)
  1223.   # We set Y here to multiples of 10 so that $x becomes below 1 - the smaller
  1224.   # $x is the faster it gets. Since 2*$x takes about 10 times as
  1225.   # long, we make it faster by about a factor of 100 by dividing $x by 10.
  1226.  
  1227.   # The same observation is valid for numbers smaller than 0.1, e.g. computing
  1228.   # log(1) is fastest, and the further away we get from 1, the longer it takes.
  1229.   # So we also 'break' this down by multiplying $x with 10 and subtract the
  1230.   # log(10) afterwards to get the correct result.
  1231.  
  1232.   # To get $x even closer to 1, we also divide by 2 and then use log(2) to
  1233.   # correct for this. For instance if $x is 2.4, we use the formula:
  1234.   #  blog(2.4 * 2) == blog (1.2) + blog(2)
  1235.   # and thus calculate only blog(1.2) and blog(2), which is faster in total
  1236.   # than calculating blog(2.4).
  1237.  
  1238.   # In addition, the values for blog(2) and blog(10) are cached.
  1239.  
  1240.   # Calculate nr of digits before dot:
  1241.   my $dbd = $MBI->_num($x->{_e});
  1242.   $dbd = -$dbd if $x->{_es} eq '-';
  1243.   $dbd += $MBI->_len($x->{_m});
  1244.  
  1245.   # more than one digit (e.g. at least 10), but *not* exactly 10 to avoid
  1246.   # infinite recursion
  1247.  
  1248.   my $calc = 1;                    # do some calculation?
  1249.  
  1250.   # disable the shortcut for 10, since we need log(10) and this would recurse
  1251.   # infinitely deep
  1252.   if ($x->{_es} eq '+' && $MBI->_is_one($x->{_e}) && $MBI->_is_one($x->{_m}))
  1253.     {
  1254.     $dbd = 0;                    # disable shortcut
  1255.     # we can use the cached value in these cases
  1256.     if ($scale <= $LOG_10_A)
  1257.       {
  1258.       $x->bzero(); $x->badd($LOG_10);        # modify $x in place
  1259.       $calc = 0;                 # no need to calc, but round
  1260.       }
  1261.     # if we can't use the shortcut, we continue normally
  1262.     }
  1263.   else
  1264.     {
  1265.     # disable the shortcut for 2, since we maybe have it cached
  1266.     if (($MBI->_is_zero($x->{_e}) && $MBI->_is_two($x->{_m})))
  1267.       {
  1268.       $dbd = 0;                    # disable shortcut
  1269.       # we can use the cached value in these cases
  1270.       if ($scale <= $LOG_2_A)
  1271.         {
  1272.         $x->bzero(); $x->badd($LOG_2);        # modify $x in place
  1273.         $calc = 0;                 # no need to calc, but round
  1274.         }
  1275.       # if we can't use the shortcut, we continue normally
  1276.       }
  1277.     }
  1278.  
  1279.   # if $x = 0.1, we know the result must be 0-log(10)
  1280.   if ($calc != 0 && $x->{_es} eq '-' && $MBI->_is_one($x->{_e}) &&
  1281.       $MBI->_is_one($x->{_m}))
  1282.     {
  1283.     $dbd = 0;                    # disable shortcut
  1284.     # we can use the cached value in these cases
  1285.     if ($scale <= $LOG_10_A)
  1286.       {
  1287.       $x->bzero(); $x->bsub($LOG_10);
  1288.       $calc = 0;                 # no need to calc, but round
  1289.       }
  1290.     }
  1291.  
  1292.   return if $calc == 0;                # already have the result
  1293.  
  1294.   # default: these correction factors are undef and thus not used
  1295.   my $l_10;                # value of ln(10) to A of $scale
  1296.   my $l_2;                # value of ln(2) to A of $scale
  1297.  
  1298.   my $two = $self->new(2);
  1299.  
  1300.   # $x == 2 => 1, $x == 13 => 2, $x == 0.1 => 0, $x == 0.01 => -1
  1301.   # so don't do this shortcut for 1 or 0
  1302.   if (($dbd > 1) || ($dbd < 0))
  1303.     {
  1304.     # convert our cached value to an object if not already (avoid doing this
  1305.     # at import() time, since not everybody needs this)
  1306.     $LOG_10 = $self->new($LOG_10,undef,undef) unless ref $LOG_10;
  1307.  
  1308.     #print "x = $x, dbd = $dbd, calc = $calc\n";
  1309.     # got more than one digit before the dot, or more than one zero after the
  1310.     # dot, so do:
  1311.     #  log(123)    == log(1.23) + log(10) * 2
  1312.     #  log(0.0123) == log(1.23) - log(10) * 2
  1313.   
  1314.     if ($scale <= $LOG_10_A)
  1315.       {
  1316.       # use cached value
  1317.       $l_10 = $LOG_10->copy();        # copy for mul
  1318.       }
  1319.     else
  1320.       {
  1321.       # else: slower, compute and cache result
  1322.       # also disable downgrade for this code path
  1323.       local $Math::BigFloat::downgrade = undef;
  1324.  
  1325.       # shorten the time to calculate log(10) based on the following:
  1326.       # log(1.25 * 8) = log(1.25) + log(8)
  1327.       #               = log(1.25) + log(2) + log(2) + log(2)
  1328.  
  1329.       # first get $l_2 (and possible compute and cache log(2))
  1330.       $LOG_2 = $self->new($LOG_2,undef,undef) unless ref $LOG_2;
  1331.       if ($scale <= $LOG_2_A)
  1332.         {
  1333.         # use cached value
  1334.         $l_2 = $LOG_2->copy();            # copy() for the mul below
  1335.         }
  1336.       else
  1337.         {
  1338.         # else: slower, compute and cache result
  1339.         $l_2 = $two->copy(); $self->_log($l_2, $scale); # scale+4, actually
  1340.         $LOG_2 = $l_2->copy();            # cache the result for later
  1341.                         # the copy() is for mul below
  1342.         $LOG_2_A = $scale;
  1343.         }
  1344.  
  1345.       # now calculate log(1.25):
  1346.       $l_10 = $self->new('1.25'); $self->_log($l_10, $scale); # scale+4, actually
  1347.  
  1348.       # log(1.25) + log(2) + log(2) + log(2):
  1349.       $l_10->badd($l_2);
  1350.       $l_10->badd($l_2);
  1351.       $l_10->badd($l_2);
  1352.       $LOG_10 = $l_10->copy();        # cache the result for later
  1353.                     # the copy() is for mul below
  1354.       $LOG_10_A = $scale;
  1355.       }
  1356.     $dbd-- if ($dbd > 1);         # 20 => dbd=2, so make it dbd=1    
  1357.     $l_10->bmul( $self->new($dbd));    # log(10) * (digits_before_dot-1)
  1358.     my $dbd_sign = '+';
  1359.     if ($dbd < 0)
  1360.       {
  1361.       $dbd = -$dbd;
  1362.       $dbd_sign = '-';
  1363.       }
  1364.     ($x->{_e}, $x->{_es}) = 
  1365.     _e_sub( $x->{_e}, $MBI->_new($dbd), $x->{_es}, $dbd_sign); # 123 => 1.23
  1366.  
  1367.     }
  1368.  
  1369.   # Now: 0.1 <= $x < 10 (and possible correction in l_10)
  1370.  
  1371.   ### Since $x in the range 0.5 .. 1.5 is MUCH faster, we do a repeated div
  1372.   ### or mul by 2 (maximum times 3, since x < 10 and x > 0.1)
  1373.  
  1374.   $HALF = $self->new($HALF) unless ref($HALF);
  1375.  
  1376.   my $twos = 0;                # default: none (0 times)    
  1377.   while ($x->bacmp($HALF) <= 0)        # X <= 0.5
  1378.     {
  1379.     $twos--; $x->bmul($two);
  1380.     }
  1381.   while ($x->bacmp($two) >= 0)        # X >= 2
  1382.     {
  1383.     $twos++; $x->bdiv($two,$scale+4);        # keep all digits
  1384.     }
  1385.   # $twos > 0 => did mul 2, < 0 => did div 2 (but we never did both)
  1386.   # So calculate correction factor based on ln(2):
  1387.   if ($twos != 0)
  1388.     {
  1389.     $LOG_2 = $self->new($LOG_2,undef,undef) unless ref $LOG_2;
  1390.     if ($scale <= $LOG_2_A)
  1391.       {
  1392.       # use cached value
  1393.       $l_2 = $LOG_2->copy();            # copy() for the mul below
  1394.       }
  1395.     else
  1396.       {
  1397.       # else: slower, compute and cache result
  1398.       # also disable downgrade for this code path
  1399.       local $Math::BigFloat::downgrade = undef;
  1400.       $l_2 = $two->copy(); $self->_log($l_2, $scale); # scale+4, actually
  1401.       $LOG_2 = $l_2->copy();            # cache the result for later
  1402.                         # the copy() is for mul below
  1403.       $LOG_2_A = $scale;
  1404.       }
  1405.     $l_2->bmul($twos);        # * -2 => subtract, * 2 => add
  1406.     }
  1407.   
  1408.   $self->_log($x,$scale);            # need to do the "normal" way
  1409.   $x->badd($l_10) if defined $l_10;         # correct it by ln(10)
  1410.   $x->badd($l_2) if defined $l_2;        # and maybe by ln(2)
  1411.  
  1412.   # all done, $x contains now the result
  1413.   $x;
  1414.   }
  1415.  
  1416. sub blcm 
  1417.   { 
  1418.   # (BFLOAT or num_str, BFLOAT or num_str) return BFLOAT
  1419.   # does not modify arguments, but returns new object
  1420.   # Lowest Common Multiplicator
  1421.  
  1422.   my ($self,@arg) = objectify(0,@_);
  1423.   my $x = $self->new(shift @arg);
  1424.   while (@arg) { $x = Math::BigInt::__lcm($x,shift @arg); } 
  1425.   $x;
  1426.   }
  1427.  
  1428. sub bgcd
  1429.   {
  1430.   # (BINT or num_str, BINT or num_str) return BINT
  1431.   # does not modify arguments, but returns new object
  1432.  
  1433.   my $y = shift;
  1434.   $y = __PACKAGE__->new($y) if !ref($y);
  1435.   my $self = ref($y);
  1436.   my $x = $y->copy()->babs();            # keep arguments
  1437.  
  1438.   return $x->bnan() if $x->{sign} !~ /^[+-]$/    # x NaN?
  1439.     || !$x->is_int();            # only for integers now
  1440.  
  1441.   while (@_)
  1442.     {
  1443.     my $t = shift; $t = $self->new($t) if !ref($t);
  1444.     $y = $t->copy()->babs();
  1445.     
  1446.     return $x->bnan() if $y->{sign} !~ /^[+-]$/    # y NaN?
  1447.          || !$y->is_int();            # only for integers now
  1448.  
  1449.     # greatest common divisor
  1450.     while (! $y->is_zero())
  1451.       {
  1452.       ($x,$y) = ($y->copy(), $x->copy()->bmod($y));
  1453.       }
  1454.  
  1455.     last if $x->is_one();
  1456.     }
  1457.   $x;
  1458.   }
  1459.  
  1460. ##############################################################################
  1461.  
  1462. sub _e_add
  1463.   {
  1464.   # Internal helper sub to take two positive integers and their signs and
  1465.   # then add them. Input ($CALC,$CALC,('+'|'-'),('+'|'-')), 
  1466.   # output ($CALC,('+'|'-'))
  1467.   my ($x,$y,$xs,$ys) = @_;
  1468.  
  1469.   # if the signs are equal we can add them (-5 + -3 => -(5 + 3) => -8)
  1470.   if ($xs eq $ys)
  1471.     {
  1472.     $x = $MBI->_add ($x, $y );        # a+b
  1473.     # the sign follows $xs
  1474.     return ($x, $xs);
  1475.     }
  1476.  
  1477.   my $a = $MBI->_acmp($x,$y);
  1478.   if ($a > 0)
  1479.     {
  1480.     $x = $MBI->_sub ($x , $y);                # abs sub
  1481.     }
  1482.   elsif ($a == 0)
  1483.     {
  1484.     $x = $MBI->_zero();                    # result is 0
  1485.     $xs = '+';
  1486.     }
  1487.   else # a < 0
  1488.     {
  1489.     $x = $MBI->_sub ( $y, $x, 1 );            # abs sub
  1490.     $xs = $ys;
  1491.     }
  1492.   ($x,$xs);
  1493.   }
  1494.  
  1495. sub _e_sub
  1496.   {
  1497.   # Internal helper sub to take two positive integers and their signs and
  1498.   # then subtract them. Input ($CALC,$CALC,('+'|'-'),('+'|'-')), 
  1499.   # output ($CALC,('+'|'-'))
  1500.   my ($x,$y,$xs,$ys) = @_;
  1501.  
  1502.   # flip sign
  1503.   $ys =~ tr/+-/-+/;
  1504.   _e_add($x,$y,$xs,$ys);        # call add (does subtract now)
  1505.   }
  1506.  
  1507. ###############################################################################
  1508. # is_foo methods (is_negative, is_positive are inherited from BigInt)
  1509.  
  1510. sub is_int
  1511.   {
  1512.   # return true if arg (BFLOAT or num_str) is an integer
  1513.   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
  1514.  
  1515.   (($x->{sign} =~ /^[+-]$/) &&            # NaN and +-inf aren't
  1516.    ($x->{_es} eq '+')) ? 1 : 0;            # 1e-1 => no integer
  1517.   }
  1518.  
  1519. sub is_zero
  1520.   {
  1521.   # return true if arg (BFLOAT or num_str) is zero
  1522.   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
  1523.  
  1524.   ($x->{sign} eq '+' && $MBI->_is_zero($x->{_m})) ? 1 : 0;
  1525.   }
  1526.  
  1527. sub is_one
  1528.   {
  1529.   # return true if arg (BFLOAT or num_str) is +1 or -1 if signis given
  1530.   my ($self,$x,$sign) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
  1531.  
  1532.   $sign = '+' if !defined $sign || $sign ne '-';
  1533.  
  1534.   ($x->{sign} eq $sign && 
  1535.    $MBI->_is_zero($x->{_e}) &&
  1536.    $MBI->_is_one($x->{_m}) ) ? 1 : 0; 
  1537.   }
  1538.  
  1539. sub is_odd
  1540.   {
  1541.   # return true if arg (BFLOAT or num_str) is odd or false if even
  1542.   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
  1543.   
  1544.   (($x->{sign} =~ /^[+-]$/) &&        # NaN & +-inf aren't
  1545.    ($MBI->_is_zero($x->{_e})) &&
  1546.    ($MBI->_is_odd($x->{_m}))) ? 1 : 0; 
  1547.   }
  1548.  
  1549. sub is_even
  1550.   {
  1551.   # return true if arg (BINT or num_str) is even or false if odd
  1552.   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
  1553.  
  1554.   (($x->{sign} =~ /^[+-]$/) &&            # NaN & +-inf aren't
  1555.    ($x->{_es} eq '+') &&             # 123.45 isn't
  1556.    ($MBI->_is_even($x->{_m}))) ? 1 : 0;        # but 1200 is
  1557.   }
  1558.  
  1559. sub bmul
  1560.   { 
  1561.   # multiply two numbers
  1562.   
  1563.   # set up parameters
  1564.   my ($self,$x,$y,@r) = (ref($_[0]),@_);
  1565.   # objectify is costly, so avoid it
  1566.   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
  1567.     {
  1568.     ($self,$x,$y,@r) = objectify(2,@_);
  1569.     }
  1570.  
  1571.   return $x if $x->modify('bmul');
  1572.  
  1573.   return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
  1574.  
  1575.   # inf handling
  1576.   if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
  1577.     {
  1578.     return $x->bnan() if $x->is_zero() || $y->is_zero(); 
  1579.     # result will always be +-inf:
  1580.     # +inf * +/+inf => +inf, -inf * -/-inf => +inf
  1581.     # +inf * -/-inf => -inf, -inf * +/+inf => -inf
  1582.     return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
  1583.     return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
  1584.     return $x->binf('-');
  1585.     }
  1586.   
  1587.   return $upgrade->bmul($x,$y,@r) if defined $upgrade &&
  1588.    ((!$x->isa($self)) || (!$y->isa($self)));
  1589.  
  1590.   # aEb * cEd = (a*c)E(b+d)
  1591.   $MBI->_mul($x->{_m},$y->{_m});
  1592.   ($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es});
  1593.  
  1594.   $r[3] = $y;                # no push!
  1595.  
  1596.   # adjust sign:
  1597.   $x->{sign} = $x->{sign} ne $y->{sign} ? '-' : '+';
  1598.   $x->bnorm->round(@r);
  1599.   }
  1600.  
  1601. sub bmuladd
  1602.   { 
  1603.   # multiply two numbers and add the third to the result
  1604.   
  1605.   # set up parameters
  1606.   my ($self,$x,$y,$z,@r) = (ref($_[0]),@_);
  1607.   # objectify is costly, so avoid it
  1608.   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
  1609.     {
  1610.     ($self,$x,$y,$z,@r) = objectify(3,@_);
  1611.     }
  1612.  
  1613.   return $x if $x->modify('bmuladd');
  1614.  
  1615.   return $x->bnan() if (($x->{sign} eq $nan) ||
  1616.             ($y->{sign} eq $nan) ||
  1617.             ($z->{sign} eq $nan));
  1618.  
  1619.   # inf handling
  1620.   if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
  1621.     {
  1622.     return $x->bnan() if $x->is_zero() || $y->is_zero(); 
  1623.     # result will always be +-inf:
  1624.     # +inf * +/+inf => +inf, -inf * -/-inf => +inf
  1625.     # +inf * -/-inf => -inf, -inf * +/+inf => -inf
  1626.     return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
  1627.     return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
  1628.     return $x->binf('-');
  1629.     }
  1630.  
  1631.   return $upgrade->bmul($x,$y,@r) if defined $upgrade &&
  1632.    ((!$x->isa($self)) || (!$y->isa($self)));
  1633.  
  1634.   # aEb * cEd = (a*c)E(b+d)
  1635.   $MBI->_mul($x->{_m},$y->{_m});
  1636.   ($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es});
  1637.  
  1638.   $r[3] = $y;                # no push!
  1639.  
  1640.   # adjust sign:
  1641.   $x->{sign} = $x->{sign} ne $y->{sign} ? '-' : '+';
  1642.  
  1643.   # z=inf handling (z=NaN handled above)
  1644.   $x->{sign} = $z->{sign}, return $x if $z->{sign} =~ /^[+-]inf$/;
  1645.  
  1646.   # take lower of the two e's and adapt m1 to it to match m2
  1647.   my $e = $z->{_e};
  1648.   $e = $MBI->_zero() if !defined $e;        # if no BFLOAT?
  1649.   $e = $MBI->_copy($e);                # make copy (didn't do it yet)
  1650.  
  1651.   my $es;
  1652.  
  1653.   ($e,$es) = _e_sub($e, $x->{_e}, $z->{_es} || '+', $x->{_es});
  1654.  
  1655.   my $add = $MBI->_copy($z->{_m});
  1656.  
  1657.   if ($es eq '-')                # < 0
  1658.     {
  1659.     $MBI->_lsft( $x->{_m}, $e, 10);
  1660.     ($x->{_e},$x->{_es}) = _e_add($x->{_e}, $e, $x->{_es}, $es);
  1661.     }
  1662.   elsif (!$MBI->_is_zero($e))            # > 0
  1663.     {
  1664.     $MBI->_lsft($add, $e, 10);
  1665.     }
  1666.   # else: both e are the same, so just leave them
  1667.  
  1668.   if ($x->{sign} eq $z->{sign})
  1669.     {
  1670.     # add
  1671.     $x->{_m} = $MBI->_add($x->{_m}, $add);
  1672.     }
  1673.   else
  1674.     {
  1675.     ($x->{_m}, $x->{sign}) = 
  1676.      _e_add($x->{_m}, $add, $x->{sign}, $z->{sign});
  1677.     }
  1678.  
  1679.   # delete trailing zeros, then round
  1680.   $x->bnorm()->round(@r);
  1681.   }
  1682.  
  1683. sub bdiv 
  1684.   {
  1685.   # (dividend: BFLOAT or num_str, divisor: BFLOAT or num_str) return 
  1686.   # (BFLOAT,BFLOAT) (quo,rem) or BFLOAT (only rem)
  1687.  
  1688.   # set up parameters
  1689.   my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_);
  1690.   # objectify is costly, so avoid it
  1691.   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
  1692.     {
  1693.     ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
  1694.     }
  1695.  
  1696.   return $x if $x->modify('bdiv');
  1697.  
  1698.   return $self->_div_inf($x,$y)
  1699.    if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
  1700.  
  1701.   # x== 0 # also: or y == 1 or y == -1
  1702.   return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero();
  1703.  
  1704.   # upgrade ?
  1705.   return $upgrade->bdiv($upgrade->new($x),$y,$a,$p,$r) if defined $upgrade;
  1706.  
  1707.   # we need to limit the accuracy to protect against overflow
  1708.   my $fallback = 0;
  1709.   my (@params,$scale);
  1710.   ($x,@params) = $x->_find_round_parameters($a,$p,$r,$y);
  1711.  
  1712.   return $x if $x->is_nan();        # error in _find_round_parameters?
  1713.  
  1714.   # no rounding at all, so must use fallback
  1715.   if (scalar @params == 0)
  1716.     {
  1717.     # simulate old behaviour
  1718.     $params[0] = $self->div_scale();    # and round to it as accuracy
  1719.     $scale = $params[0]+4;         # at least four more for proper round
  1720.     $params[2] = $r;            # round mode by caller or undef
  1721.     $fallback = 1;            # to clear a/p afterwards
  1722.     }
  1723.   else
  1724.     {
  1725.     # the 4 below is empirical, and there might be cases where it is not
  1726.     # enough...
  1727.     $scale = abs($params[0] || $params[1]) + 4;    # take whatever is defined
  1728.     }
  1729.  
  1730.   my $rem; $rem = $self->bzero() if wantarray;
  1731.  
  1732.   $y = $self->new($y) unless $y->isa('Math::BigFloat');
  1733.  
  1734.   my $lx = $MBI->_len($x->{_m}); my $ly = $MBI->_len($y->{_m});
  1735.   $scale = $lx if $lx > $scale;
  1736.   $scale = $ly if $ly > $scale;
  1737.   my $diff = $ly - $lx;
  1738.   $scale += $diff if $diff > 0;        # if lx << ly, but not if ly << lx!
  1739.  
  1740.   # already handled inf/NaN/-inf above:
  1741.  
  1742.   # check that $y is not 1 nor -1 and cache the result:
  1743.   my $y_not_one = !($MBI->_is_zero($y->{_e}) && $MBI->_is_one($y->{_m}));
  1744.  
  1745.   # flipping the sign of $y will also flip the sign of $x for the special
  1746.   # case of $x->bsub($x); so we can catch it below:
  1747.   my $xsign = $x->{sign};
  1748.   $y->{sign} =~ tr/+-/-+/;
  1749.  
  1750.   if ($xsign ne $x->{sign})
  1751.     {
  1752.     # special case of $x /= $x results in 1
  1753.     $x->bone();            # "fixes" also sign of $y, since $x is $y
  1754.     }
  1755.   else
  1756.     {
  1757.     # correct $y's sign again
  1758.     $y->{sign} =~ tr/+-/-+/;
  1759.     # continue with normal div code:
  1760.  
  1761.     # make copy of $x in case of list context for later reminder calculation
  1762.     if (wantarray && $y_not_one)
  1763.       {
  1764.       $rem = $x->copy();
  1765.       }
  1766.  
  1767.     $x->{sign} = $x->{sign} ne $y->sign() ? '-' : '+'; 
  1768.  
  1769.     # check for / +-1 ( +/- 1E0)
  1770.     if ($y_not_one)
  1771.       {
  1772.       # promote BigInts and it's subclasses (except when already a BigFloat)
  1773.       $y = $self->new($y) unless $y->isa('Math::BigFloat'); 
  1774.  
  1775.       # calculate the result to $scale digits and then round it
  1776.       # a * 10 ** b / c * 10 ** d => a/c * 10 ** (b-d)
  1777.       $MBI->_lsft($x->{_m},$MBI->_new($scale),10);
  1778.       $MBI->_div ($x->{_m},$y->{_m});    # a/c
  1779.  
  1780.       # correct exponent of $x
  1781.       ($x->{_e},$x->{_es}) = _e_sub($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es});
  1782.       # correct for 10**scale
  1783.       ($x->{_e},$x->{_es}) = _e_sub($x->{_e}, $MBI->_new($scale), $x->{_es}, '+');
  1784.       $x->bnorm();        # remove trailing 0's
  1785.       }
  1786.     } # ende else $x != $y
  1787.  
  1788.   # shortcut to not run through _find_round_parameters again
  1789.   if (defined $params[0])
  1790.     {
  1791.     delete $x->{_a};                 # clear before round
  1792.     $x->bround($params[0],$params[2]);        # then round accordingly
  1793.     }
  1794.   else
  1795.     {
  1796.     delete $x->{_p};                 # clear before round
  1797.     $x->bfround($params[1],$params[2]);        # then round accordingly
  1798.     }
  1799.   if ($fallback)
  1800.     {
  1801.     # clear a/p after round, since user did not request it
  1802.     delete $x->{_a}; delete $x->{_p};
  1803.     }
  1804.  
  1805.   if (wantarray)
  1806.     {
  1807.     if ($y_not_one)
  1808.       {
  1809.       $rem->bmod($y,@params);            # copy already done
  1810.       }
  1811.     if ($fallback)
  1812.       {
  1813.       # clear a/p after round, since user did not request it
  1814.       delete $rem->{_a}; delete $rem->{_p};
  1815.       }
  1816.     return ($x,$rem);
  1817.     }
  1818.   $x;
  1819.   }
  1820.  
  1821. sub bmod 
  1822.   {
  1823.   # (dividend: BFLOAT or num_str, divisor: BFLOAT or num_str) return reminder 
  1824.  
  1825.   # set up parameters
  1826.   my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_);
  1827.   # objectify is costly, so avoid it
  1828.   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
  1829.     {
  1830.     ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
  1831.     }
  1832.  
  1833.   return $x if $x->modify('bmod');
  1834.  
  1835.   # handle NaN, inf, -inf
  1836.   if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
  1837.     {
  1838.     my ($d,$re) = $self->SUPER::_div_inf($x,$y);
  1839.     $x->{sign} = $re->{sign};
  1840.     $x->{_e} = $re->{_e};
  1841.     $x->{_m} = $re->{_m};
  1842.     return $x->round($a,$p,$r,$y);
  1843.     } 
  1844.   if ($y->is_zero())
  1845.     {
  1846.     return $x->bnan() if $x->is_zero();
  1847.     return $x;
  1848.     }
  1849.  
  1850.   return $x->bzero() if $x->is_zero()
  1851.  || ($x->is_int() &&
  1852.   # check that $y == +1 or $y == -1:
  1853.     ($MBI->_is_zero($y->{_e}) && $MBI->_is_one($y->{_m})));
  1854.  
  1855.   my $cmp = $x->bacmp($y);            # equal or $x < $y?
  1856.   return $x->bzero($a,$p) if $cmp == 0;        # $x == $y => result 0
  1857.  
  1858.   # only $y of the operands negative? 
  1859.   my $neg = 0; $neg = 1 if $x->{sign} ne $y->{sign};
  1860.  
  1861.   $x->{sign} = $y->{sign};                # calc sign first
  1862.   return $x->round($a,$p,$r) if $cmp < 0 && $neg == 0;    # $x < $y => result $x
  1863.   
  1864.   my $ym = $MBI->_copy($y->{_m});
  1865.   
  1866.   # 2e1 => 20
  1867.   $MBI->_lsft( $ym, $y->{_e}, 10) 
  1868.    if $y->{_es} eq '+' && !$MBI->_is_zero($y->{_e});
  1869.  
  1870.   # if $y has digits after dot
  1871.   my $shifty = 0;            # correct _e of $x by this
  1872.   if ($y->{_es} eq '-')            # has digits after dot
  1873.     {
  1874.     # 123 % 2.5 => 1230 % 25 => 5 => 0.5
  1875.     $shifty = $MBI->_num($y->{_e});     # no more digits after dot
  1876.     $MBI->_lsft($x->{_m}, $y->{_e}, 10);# 123 => 1230, $y->{_m} is already 25
  1877.     }
  1878.   # $ym is now mantissa of $y based on exponent 0
  1879.  
  1880.   my $shiftx = 0;            # correct _e of $x by this
  1881.   if ($x->{_es} eq '-')            # has digits after dot
  1882.     {
  1883.     # 123.4 % 20 => 1234 % 200
  1884.     $shiftx = $MBI->_num($x->{_e});    # no more digits after dot
  1885.     $MBI->_lsft($ym, $x->{_e}, 10);    # 123 => 1230
  1886.     }
  1887.   # 123e1 % 20 => 1230 % 20
  1888.   if ($x->{_es} eq '+' && !$MBI->_is_zero($x->{_e}))
  1889.     {
  1890.     $MBI->_lsft( $x->{_m}, $x->{_e},10);    # es => '+' here
  1891.     }
  1892.  
  1893.   $x->{_e} = $MBI->_new($shiftx);
  1894.   $x->{_es} = '+'; 
  1895.   $x->{_es} = '-' if $shiftx != 0 || $shifty != 0;
  1896.   $MBI->_add( $x->{_e}, $MBI->_new($shifty)) if $shifty != 0;
  1897.   
  1898.   # now mantissas are equalized, exponent of $x is adjusted, so calc result
  1899.  
  1900.   $x->{_m} = $MBI->_mod( $x->{_m}, $ym);
  1901.  
  1902.   $x->{sign} = '+' if $MBI->_is_zero($x->{_m});        # fix sign for -0
  1903.   $x->bnorm();
  1904.  
  1905.   if ($neg != 0)    # one of them negative => correct in place
  1906.     {
  1907.     my $r = $y - $x;
  1908.     $x->{_m} = $r->{_m};
  1909.     $x->{_e} = $r->{_e};
  1910.     $x->{_es} = $r->{_es};
  1911.     $x->{sign} = '+' if $MBI->_is_zero($x->{_m});    # fix sign for -0
  1912.     $x->bnorm();
  1913.     }
  1914.  
  1915.   $x->round($a,$p,$r,$y);    # round and return
  1916.   }
  1917.  
  1918. sub broot
  1919.   {
  1920.   # calculate $y'th root of $x
  1921.   
  1922.   # set up parameters
  1923.   my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_);
  1924.   # objectify is costly, so avoid it
  1925.   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
  1926.     {
  1927.     ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
  1928.     }
  1929.  
  1930.   return $x if $x->modify('broot');
  1931.  
  1932.   # NaN handling: $x ** 1/0, x or y NaN, or y inf/-inf or y == 0
  1933.   return $x->bnan() if $x->{sign} !~ /^\+/ || $y->is_zero() ||
  1934.          $y->{sign} !~ /^\+$/;
  1935.  
  1936.   return $x if $x->is_zero() || $x->is_one() || $x->is_inf() || $y->is_one();
  1937.   
  1938.   # we need to limit the accuracy to protect against overflow
  1939.   my $fallback = 0;
  1940.   my (@params,$scale);
  1941.   ($x,@params) = $x->_find_round_parameters($a,$p,$r);
  1942.  
  1943.   return $x if $x->is_nan();        # error in _find_round_parameters?
  1944.  
  1945.   # no rounding at all, so must use fallback
  1946.   if (scalar @params == 0) 
  1947.     {
  1948.     # simulate old behaviour
  1949.     $params[0] = $self->div_scale();    # and round to it as accuracy
  1950.     $scale = $params[0]+4;         # at least four more for proper round
  1951.     $params[2] = $r;            # iound mode by caller or undef
  1952.     $fallback = 1;            # to clear a/p afterwards
  1953.     }
  1954.   else
  1955.     {
  1956.     # the 4 below is empirical, and there might be cases where it is not
  1957.     # enough...
  1958.     $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
  1959.     }
  1960.  
  1961.   # when user set globals, they would interfere with our calculation, so
  1962.   # disable them and later re-enable them
  1963.   no strict 'refs';
  1964.   my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef;
  1965.   my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef;
  1966.   # we also need to disable any set A or P on $x (_find_round_parameters took
  1967.   # them already into account), since these would interfere, too
  1968.   delete $x->{_a}; delete $x->{_p};
  1969.   # need to disable $upgrade in BigInt, to avoid deep recursion
  1970.   local $Math::BigInt::upgrade = undef;    # should be really parent class vs MBI
  1971.  
  1972.   # remember sign and make $x positive, since -4 ** (1/2) => -2
  1973.   my $sign = 0; $sign = 1 if $x->{sign} eq '-'; $x->{sign} = '+';
  1974.  
  1975.   my $is_two = 0;
  1976.   if ($y->isa('Math::BigFloat'))
  1977.     {
  1978.     $is_two = ($y->{sign} eq '+' && $MBI->_is_two($y->{_m}) && $MBI->_is_zero($y->{_e}));
  1979.     }
  1980.   else
  1981.     {
  1982.     $is_two = ($y == 2);
  1983.     }
  1984.  
  1985.   # normal square root if $y == 2:
  1986.   if ($is_two)
  1987.     {
  1988.     $x->bsqrt($scale+4);
  1989.     }
  1990.   elsif ($y->is_one('-'))
  1991.     {
  1992.     # $x ** -1 => 1/$x
  1993.     my $u = $self->bone()->bdiv($x,$scale);
  1994.     # copy private parts over
  1995.     $x->{_m} = $u->{_m};
  1996.     $x->{_e} = $u->{_e};
  1997.     $x->{_es} = $u->{_es};
  1998.     }
  1999.   else
  2000.     {
  2001.     # calculate the broot() as integer result first, and if it fits, return
  2002.     # it rightaway (but only if $x and $y are integer):
  2003.  
  2004.     my $done = 0;                # not yet
  2005.     if ($y->is_int() && $x->is_int())
  2006.       {
  2007.       my $i = $MBI->_copy( $x->{_m} );
  2008.       $MBI->_lsft( $i, $x->{_e}, 10 ) unless $MBI->_is_zero($x->{_e});
  2009.       my $int = Math::BigInt->bzero();
  2010.       $int->{value} = $i;
  2011.       $int->broot($y->as_number());
  2012.       # if ($exact)
  2013.       if ($int->copy()->bpow($y) == $x)
  2014.         {
  2015.         # found result, return it
  2016.         $x->{_m} = $int->{value};
  2017.         $x->{_e} = $MBI->_zero();
  2018.         $x->{_es} = '+';
  2019.         $x->bnorm();
  2020.         $done = 1;
  2021.         }
  2022.       }
  2023.     if ($done == 0)
  2024.       {
  2025.       my $u = $self->bone()->bdiv($y,$scale+4);
  2026.       delete $u->{_a}; delete $u->{_p};         # otherwise it conflicts
  2027.       $x->bpow($u,$scale+4);                    # el cheapo
  2028.       }
  2029.     }
  2030.   $x->bneg() if $sign == 1;
  2031.   
  2032.   # shortcut to not run through _find_round_parameters again
  2033.   if (defined $params[0])
  2034.     {
  2035.     $x->bround($params[0],$params[2]);        # then round accordingly
  2036.     }
  2037.   else
  2038.     {
  2039.     $x->bfround($params[1],$params[2]);        # then round accordingly
  2040.     }
  2041.   if ($fallback)
  2042.     {
  2043.     # clear a/p after round, since user did not request it
  2044.     delete $x->{_a}; delete $x->{_p};
  2045.     }
  2046.   # restore globals
  2047.   $$abr = $ab; $$pbr = $pb;
  2048.   $x;
  2049.   }
  2050.  
  2051. sub bsqrt
  2052.   { 
  2053.   # calculate square root
  2054.   my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
  2055.  
  2056.   return $x if $x->modify('bsqrt');
  2057.  
  2058.   return $x->bnan() if $x->{sign} !~ /^[+]/;    # NaN, -inf or < 0
  2059.   return $x if $x->{sign} eq '+inf';        # sqrt(inf) == inf
  2060.   return $x->round($a,$p,$r) if $x->is_zero() || $x->is_one();
  2061.  
  2062.   # we need to limit the accuracy to protect against overflow
  2063.   my $fallback = 0;
  2064.   my (@params,$scale);
  2065.   ($x,@params) = $x->_find_round_parameters($a,$p,$r);
  2066.  
  2067.   return $x if $x->is_nan();        # error in _find_round_parameters?
  2068.  
  2069.   # no rounding at all, so must use fallback
  2070.   if (scalar @params == 0) 
  2071.     {
  2072.     # simulate old behaviour
  2073.     $params[0] = $self->div_scale();    # and round to it as accuracy
  2074.     $scale = $params[0]+4;         # at least four more for proper round
  2075.     $params[2] = $r;            # round mode by caller or undef
  2076.     $fallback = 1;            # to clear a/p afterwards
  2077.     }
  2078.   else
  2079.     {
  2080.     # the 4 below is empirical, and there might be cases where it is not
  2081.     # enough...
  2082.     $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
  2083.     }
  2084.  
  2085.   # when user set globals, they would interfere with our calculation, so
  2086.   # disable them and later re-enable them
  2087.   no strict 'refs';
  2088.   my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef;
  2089.   my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef;
  2090.   # we also need to disable any set A or P on $x (_find_round_parameters took
  2091.   # them already into account), since these would interfere, too
  2092.   delete $x->{_a}; delete $x->{_p};
  2093.   # need to disable $upgrade in BigInt, to avoid deep recursion
  2094.   local $Math::BigInt::upgrade = undef;    # should be really parent class vs MBI
  2095.  
  2096.   my $i = $MBI->_copy( $x->{_m} );
  2097.   $MBI->_lsft( $i, $x->{_e}, 10 ) unless $MBI->_is_zero($x->{_e});
  2098.   my $xas = Math::BigInt->bzero();
  2099.   $xas->{value} = $i;
  2100.  
  2101.   my $gs = $xas->copy()->bsqrt();    # some guess
  2102.  
  2103.   if (($x->{_es} ne '-')        # guess can't be accurate if there are
  2104.                     # digits after the dot
  2105.    && ($xas->bacmp($gs * $gs) == 0))    # guess hit the nail on the head?
  2106.     {
  2107.     # exact result, copy result over to keep $x
  2108.     $x->{_m} = $gs->{value}; $x->{_e} = $MBI->_zero(); $x->{_es} = '+';
  2109.     $x->bnorm();
  2110.     # shortcut to not run through _find_round_parameters again
  2111.     if (defined $params[0])
  2112.       {
  2113.       $x->bround($params[0],$params[2]);    # then round accordingly
  2114.       }
  2115.     else
  2116.       {
  2117.       $x->bfround($params[1],$params[2]);    # then round accordingly
  2118.       }
  2119.     if ($fallback)
  2120.       {
  2121.       # clear a/p after round, since user did not request it
  2122.       delete $x->{_a}; delete $x->{_p};
  2123.       }
  2124.     # re-enable A and P, upgrade is taken care of by "local"
  2125.     ${"$self\::accuracy"} = $ab; ${"$self\::precision"} = $pb;
  2126.     return $x;
  2127.     }
  2128.  
  2129.   # sqrt(2) = 1.4 because sqrt(2*100) = 1.4*10; so we can increase the accuracy
  2130.   # of the result by multipyling the input by 100 and then divide the integer
  2131.   # result of sqrt(input) by 10. Rounding afterwards returns the real result.
  2132.  
  2133.   # The following steps will transform 123.456 (in $x) into 123456 (in $y1)
  2134.   my $y1 = $MBI->_copy($x->{_m});
  2135.  
  2136.   my $length = $MBI->_len($y1);
  2137.   
  2138.   # Now calculate how many digits the result of sqrt(y1) would have
  2139.   my $digits = int($length / 2);
  2140.  
  2141.   # But we need at least $scale digits, so calculate how many are missing
  2142.   my $shift = $scale - $digits;
  2143.  
  2144.   # This happens if the input had enough digits 
  2145.   # (we take care of integer guesses above)
  2146.   $shift = 0 if $shift < 0; 
  2147.  
  2148.   # Multiply in steps of 100, by shifting left two times the "missing" digits
  2149.   my $s2 = $shift * 2;
  2150.  
  2151.   # We now make sure that $y1 has the same odd or even number of digits than
  2152.   # $x had. So when _e of $x is odd, we must shift $y1 by one digit left,
  2153.   # because we always must multiply by steps of 100 (sqrt(100) is 10) and not
  2154.   # steps of 10. The length of $x does not count, since an even or odd number
  2155.   # of digits before the dot is not changed by adding an even number of digits
  2156.   # after the dot (the result is still odd or even digits long).
  2157.   $s2++ if $MBI->_is_odd($x->{_e});
  2158.  
  2159.   $MBI->_lsft( $y1, $MBI->_new($s2), 10);
  2160.  
  2161.   # now take the square root and truncate to integer
  2162.   $y1 = $MBI->_sqrt($y1);
  2163.  
  2164.   # By "shifting" $y1 right (by creating a negative _e) we calculate the final
  2165.   # result, which is than later rounded to the desired scale.
  2166.  
  2167.   # calculate how many zeros $x had after the '.' (or before it, depending
  2168.   # on sign of $dat, the result should have half as many:
  2169.   my $dat = $MBI->_num($x->{_e});
  2170.   $dat = -$dat if $x->{_es} eq '-';
  2171.   $dat += $length;
  2172.  
  2173.   if ($dat > 0)
  2174.     {
  2175.     # no zeros after the dot (e.g. 1.23, 0.49 etc)
  2176.     # preserve half as many digits before the dot than the input had 
  2177.     # (but round this "up")
  2178.     $dat = int(($dat+1)/2);
  2179.     }
  2180.   else
  2181.     {
  2182.     $dat = int(($dat)/2);
  2183.     }
  2184.   $dat -= $MBI->_len($y1);
  2185.   if ($dat < 0)
  2186.     {
  2187.     $dat = abs($dat);
  2188.     $x->{_e} = $MBI->_new( $dat );
  2189.     $x->{_es} = '-';
  2190.     }
  2191.   else
  2192.     {    
  2193.     $x->{_e} = $MBI->_new( $dat );
  2194.     $x->{_es} = '+';
  2195.     }
  2196.   $x->{_m} = $y1;
  2197.   $x->bnorm();
  2198.  
  2199.   # shortcut to not run through _find_round_parameters again
  2200.   if (defined $params[0])
  2201.     {
  2202.     $x->bround($params[0],$params[2]);        # then round accordingly
  2203.     }
  2204.   else
  2205.     {
  2206.     $x->bfround($params[1],$params[2]);        # then round accordingly
  2207.     }
  2208.   if ($fallback)
  2209.     {
  2210.     # clear a/p after round, since user did not request it
  2211.     delete $x->{_a}; delete $x->{_p};
  2212.     }
  2213.   # restore globals
  2214.   $$abr = $ab; $$pbr = $pb;
  2215.   $x;
  2216.   }
  2217.  
  2218. sub bfac
  2219.   {
  2220.   # (BFLOAT or num_str, BFLOAT or num_str) return BFLOAT
  2221.   # compute factorial number, modifies first argument
  2222.  
  2223.   # set up parameters
  2224.   my ($self,$x,@r) = (ref($_[0]),@_);
  2225.   # objectify is costly, so avoid it
  2226.   ($self,$x,@r) = objectify(1,@_) if !ref($x);
  2227.  
  2228.   # inf => inf
  2229.   return $x if $x->modify('bfac') || $x->{sign} eq '+inf';    
  2230.  
  2231.   return $x->bnan() 
  2232.     if (($x->{sign} ne '+') ||        # inf, NaN, <0 etc => NaN
  2233.      ($x->{_es} ne '+'));        # digits after dot?
  2234.  
  2235.   # use BigInt's bfac() for faster calc
  2236.   if (! $MBI->_is_zero($x->{_e}))
  2237.     {
  2238.     $MBI->_lsft($x->{_m}, $x->{_e},10);    # change 12e1 to 120e0
  2239.     $x->{_e} = $MBI->_zero();        # normalize
  2240.     $x->{_es} = '+';
  2241.     }
  2242.   $MBI->_fac($x->{_m});            # calculate factorial
  2243.   $x->bnorm()->round(@r);         # norm again and round result
  2244.   }
  2245.  
  2246. sub _pow
  2247.   {
  2248.   # Calculate a power where $y is a non-integer, like 2 ** 0.3
  2249.   my ($x,$y,@r) = @_;
  2250.   my $self = ref($x);
  2251.  
  2252.   # if $y == 0.5, it is sqrt($x)
  2253.   $HALF = $self->new($HALF) unless ref($HALF);
  2254.   return $x->bsqrt(@r,$y) if $y->bcmp($HALF) == 0;
  2255.  
  2256.   # Using:
  2257.   # a ** x == e ** (x * ln a)
  2258.  
  2259.   # u = y * ln x
  2260.   #                _                         _
  2261.   # Taylor:       |   u    u^2    u^3         |
  2262.   # x ** y  = 1 + |  --- + --- + ----- + ...  |
  2263.   #               |_  1    1*2   1*2*3       _|
  2264.  
  2265.   # we need to limit the accuracy to protect against overflow
  2266.   my $fallback = 0;
  2267.   my ($scale,@params);
  2268.   ($x,@params) = $x->_find_round_parameters(@r);
  2269.     
  2270.   return $x if $x->is_nan();        # error in _find_round_parameters?
  2271.  
  2272.   # no rounding at all, so must use fallback
  2273.   if (scalar @params == 0)
  2274.     {
  2275.     # simulate old behaviour
  2276.     $params[0] = $self->div_scale();    # and round to it as accuracy
  2277.     $params[1] = undef;            # disable P
  2278.     $scale = $params[0]+4;         # at least four more for proper round
  2279.     $params[2] = $r[2];            # round mode by caller or undef
  2280.     $fallback = 1;            # to clear a/p afterwards
  2281.     }
  2282.   else
  2283.     {
  2284.     # the 4 below is empirical, and there might be cases where it is not
  2285.     # enough...
  2286.     $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
  2287.     }
  2288.  
  2289.   # when user set globals, they would interfere with our calculation, so
  2290.   # disable them and later re-enable them
  2291.   no strict 'refs';
  2292.   my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef;
  2293.   my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef;
  2294.   # we also need to disable any set A or P on $x (_find_round_parameters took
  2295.   # them already into account), since these would interfere, too
  2296.   delete $x->{_a}; delete $x->{_p};
  2297.   # need to disable $upgrade in BigInt, to avoid deep recursion
  2298.   local $Math::BigInt::upgrade = undef;
  2299.  
  2300.   my ($limit,$v,$u,$below,$factor,$next,$over);
  2301.  
  2302.   $u = $x->copy()->blog(undef,$scale)->bmul($y);
  2303.   $v = $self->bone();                # 1
  2304.   $factor = $self->new(2);            # 2
  2305.   $x->bone();                    # first term: 1
  2306.  
  2307.   $below = $v->copy();
  2308.   $over = $u->copy();
  2309.  
  2310.   $limit = $self->new("1E-". ($scale-1));
  2311.   #my $steps = 0;
  2312.   while (3 < 5)
  2313.     {
  2314.     # we calculate the next term, and add it to the last
  2315.     # when the next term is below our limit, it won't affect the outcome
  2316.     # anymore, so we stop:
  2317.     $next = $over->copy()->bdiv($below,$scale);
  2318.     last if $next->bacmp($limit) <= 0;
  2319.     $x->badd($next);
  2320.     # calculate things for the next term
  2321.     $over *= $u; $below *= $factor; $factor->binc();
  2322.  
  2323.     last if $x->{sign} !~ /^[-+]$/;
  2324.  
  2325.     #$steps++;
  2326.     }
  2327.   
  2328.   # shortcut to not run through _find_round_parameters again
  2329.   if (defined $params[0])
  2330.     {
  2331.     $x->bround($params[0],$params[2]);        # then round accordingly
  2332.     }
  2333.   else
  2334.     {
  2335.     $x->bfround($params[1],$params[2]);        # then round accordingly
  2336.     }
  2337.   if ($fallback)
  2338.     {
  2339.     # clear a/p after round, since user did not request it
  2340.     delete $x->{_a}; delete $x->{_p};
  2341.     }
  2342.   # restore globals
  2343.   $$abr = $ab; $$pbr = $pb;
  2344.   $x;
  2345.   }
  2346.  
  2347. sub bpow 
  2348.   {
  2349.   # (BFLOAT or num_str, BFLOAT or num_str) return BFLOAT
  2350.   # compute power of two numbers, second arg is used as integer
  2351.   # modifies first argument
  2352.  
  2353.   # set up parameters
  2354.   my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_);
  2355.   # objectify is costly, so avoid it
  2356.   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
  2357.     {
  2358.     ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
  2359.     }
  2360.  
  2361.   return $x if $x->modify('bpow');
  2362.  
  2363.   return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
  2364.   return $x if $x->{sign} =~ /^[+-]inf$/;
  2365.   
  2366.   # cache the result of is_zero
  2367.   my $y_is_zero = $y->is_zero();
  2368.   return $x->bone() if $y_is_zero;
  2369.   return $x         if $x->is_one() || $y->is_one();
  2370.  
  2371.   my $x_is_zero = $x->is_zero();
  2372.   return $x->_pow($y,$a,$p,$r) if !$x_is_zero && !$y->is_int();        # non-integer power
  2373.  
  2374.   my $y1 = $y->as_number()->{value};            # make MBI part
  2375.  
  2376.   # if ($x == -1)
  2377.   if ($x->{sign} eq '-' && $MBI->_is_one($x->{_m}) && $MBI->_is_zero($x->{_e}))
  2378.     {
  2379.     # if $x == -1 and odd/even y => +1/-1  because +-1 ^ (+-1) => +-1
  2380.     return $MBI->_is_odd($y1) ? $x : $x->babs(1);
  2381.     }
  2382.   if ($x_is_zero)
  2383.     {
  2384.     return $x if $y->{sign} eq '+';     # 0**y => 0 (if not y <= 0)
  2385.     # 0 ** -y => 1 / (0 ** y) => 1 / 0! (1 / 0 => +inf)
  2386.     return $x->binf();
  2387.     }
  2388.  
  2389.   my $new_sign = '+';
  2390.   $new_sign = $MBI->_is_odd($y1) ? '-' : '+' if $x->{sign} ne '+';
  2391.  
  2392.   # calculate $x->{_m} ** $y and $x->{_e} * $y separately (faster)
  2393.   $x->{_m} = $MBI->_pow( $x->{_m}, $y1);
  2394.   $x->{_e} = $MBI->_mul ($x->{_e}, $y1);
  2395.  
  2396.   $x->{sign} = $new_sign;
  2397.   $x->bnorm();
  2398.   if ($y->{sign} eq '-')
  2399.     {
  2400.     # modify $x in place!
  2401.     my $z = $x->copy(); $x->bone();
  2402.     return scalar $x->bdiv($z,$a,$p,$r);    # round in one go (might ignore y's A!)
  2403.     }
  2404.   $x->round($a,$p,$r,$y);
  2405.   }
  2406.  
  2407. sub bmodpow
  2408.   {
  2409.   # takes a very large number to a very large exponent in a given very
  2410.   # large modulus, quickly, thanks to binary exponentation. Supports
  2411.   # negative exponents.
  2412.   my ($self,$num,$exp,$mod,@r) = objectify(3,@_);
  2413.  
  2414.   return $num if $num->modify('bmodpow');
  2415.  
  2416.   # check modulus for valid values
  2417.   return $num->bnan() if ($mod->{sign} ne '+'           # NaN, - , -inf, +inf
  2418.                        || $mod->is_zero());
  2419.  
  2420.   # check exponent for valid values
  2421.   if ($exp->{sign} =~ /\w/)
  2422.     {
  2423.     # i.e., if it's NaN, +inf, or -inf...
  2424.     return $num->bnan();
  2425.     }
  2426.  
  2427.   $num->bmodinv ($mod) if ($exp->{sign} eq '-');
  2428.  
  2429.   # check num for valid values (also NaN if there was no inverse but $exp < 0)
  2430.   return $num->bnan() if $num->{sign} !~ /^[+-]$/;
  2431.  
  2432.   # $mod is positive, sign on $exp is ignored, result also positive
  2433.  
  2434.   # XXX TODO: speed it up when all three numbers are integers
  2435.   $num->bpow($exp)->bmod($mod);
  2436.   }
  2437.  
  2438. ###############################################################################
  2439. # trigonometric functions
  2440.  
  2441. # helper function for bpi() and batan2(), calculates arcus tanges (1/x)
  2442.  
  2443. sub _atan_inv
  2444.   {
  2445.   # return a/b so that a/b approximates atan(1/x) to at least limit digits
  2446.   my ($self, $x, $limit) = @_;
  2447.  
  2448.   # Taylor:       x^3   x^5   x^7   x^9
  2449.   #    atan = x - --- + --- - --- + --- - ...
  2450.   #                3     5     7     9 
  2451.  
  2452.   #               1      1         1        1
  2453.   #    atan 1/x = - - ------- + ------- - ------- + ...
  2454.   #               x   x^3 * 3   x^5 * 5   x^7 * 7 
  2455.  
  2456.   #               1      1         1            1
  2457.   #    atan 1/x = - - --------- + ---------- - ----------- + ... 
  2458.   #               5    3 * 125     5 * 3125     7 * 78125
  2459.  
  2460.   # Subtraction/addition of a rational:
  2461.  
  2462.   #  5    7    5*3 +- 7*4
  2463.   #  - +- -  = ----------
  2464.   #  4    3       4*3
  2465.  
  2466.   # Term:  N        N+1
  2467.   #
  2468.   #        a             1                  a * d * c +- b
  2469.   #        ----- +- ------------------  =  ----------------
  2470.   #        b           d * c                b * d * c
  2471.  
  2472.   #  since b1 = b0 * (d-2) * c
  2473.  
  2474.   #        a             1                  a * d +- b / c
  2475.   #        ----- +- ------------------  =  ----------------
  2476.   #        b           d * c                b * d 
  2477.  
  2478.   # and  d = d + 2
  2479.   # and  c = c * x * x
  2480.  
  2481.   #        u = d * c
  2482.   #        stop if length($u) > limit 
  2483.   #        a = a * u +- b
  2484.   #        b = b * u
  2485.   #        d = d + 2
  2486.   #        c = c * x * x
  2487.   #        sign = 1 - sign
  2488.  
  2489.   my $a = $MBI->_one();
  2490.   my $b = $MBI->_copy($x);
  2491.  
  2492.   my $x2  = $MBI->_mul( $MBI->_copy($x), $b);        # x2 = x * x
  2493.   my $d   = $MBI->_new( 3 );                # d = 3
  2494.   my $c   = $MBI->_mul( $MBI->_copy($x), $x2);        # c = x ^ 3
  2495.   my $two = $MBI->_new( 2 );
  2496.  
  2497.   # run the first step unconditionally
  2498.   my $u = $MBI->_mul( $MBI->_copy($d), $c);
  2499.   $a = $MBI->_mul($a, $u);
  2500.   $a = $MBI->_sub($a, $b);
  2501.   $b = $MBI->_mul($b, $u);
  2502.   $d = $MBI->_add($d, $two);
  2503.   $c = $MBI->_mul($c, $x2);
  2504.  
  2505.   # a is now a * (d-3) * c
  2506.   # b is now b * (d-2) * c
  2507.  
  2508.   # run the second step unconditionally
  2509.   $u = $MBI->_mul( $MBI->_copy($d), $c);
  2510.   $a = $MBI->_mul($a, $u);
  2511.   $a = $MBI->_add($a, $b);
  2512.   $b = $MBI->_mul($b, $u);
  2513.   $d = $MBI->_add($d, $two);
  2514.   $c = $MBI->_mul($c, $x2);
  2515.  
  2516.   # a is now a * (d-3) * (d-5) * c * c  
  2517.   # b is now b * (d-2) * (d-4) * c * c
  2518.  
  2519.   # so we can remove c * c from both a and b to shorten the numbers involved:
  2520.   $a = $MBI->_div($a, $x2);
  2521.   $b = $MBI->_div($b, $x2);
  2522.   $a = $MBI->_div($a, $x2);
  2523.   $b = $MBI->_div($b, $x2);
  2524.  
  2525. #  my $step = 0; 
  2526.   my $sign = 0;                        # 0 => -, 1 => +
  2527.   while (3 < 5)
  2528.     {
  2529. #    $step++;
  2530. #    if (($i++ % 100) == 0)
  2531. #      {
  2532. #    print "a=",$MBI->_str($a),"\n";
  2533. #    print "b=",$MBI->_str($b),"\n";
  2534. #      }
  2535. #    print "d=",$MBI->_str($d),"\n";
  2536. #    print "x2=",$MBI->_str($x2),"\n";
  2537. #    print "c=",$MBI->_str($c),"\n";
  2538.  
  2539.     my $u = $MBI->_mul( $MBI->_copy($d), $c);
  2540.     # use _alen() for libs like GMP where _len() would be O(N^2)
  2541.     last if $MBI->_alen($u) > $limit;
  2542.     my ($bc,$r) = $MBI->_div( $MBI->_copy($b), $c);
  2543.     if ($MBI->_is_zero($r))
  2544.       {
  2545.       # b / c is an integer, so we can remove c from all terms
  2546.       # this happens almost every time:
  2547.       $a = $MBI->_mul($a, $d);
  2548.       $a = $MBI->_sub($a, $bc) if $sign == 0;
  2549.       $a = $MBI->_add($a, $bc) if $sign == 1;
  2550.       $b = $MBI->_mul($b, $d);
  2551.       }
  2552.     else
  2553.       {
  2554.       # b / c is not an integer, so we keep c in the terms
  2555.       # this happens very rarely, for instance for x = 5, this happens only
  2556.       # at the following steps:
  2557.       # 1, 5, 14, 32, 72, 157, 340, ...
  2558.       $a = $MBI->_mul($a, $u);
  2559.       $a = $MBI->_sub($a, $b) if $sign == 0;
  2560.       $a = $MBI->_add($a, $b) if $sign == 1;
  2561.       $b = $MBI->_mul($b, $u);
  2562.       }
  2563.     $d = $MBI->_add($d, $two);
  2564.     $c = $MBI->_mul($c, $x2);
  2565.     $sign = 1 - $sign;
  2566.  
  2567.     }
  2568.  
  2569. #  print "Took $step steps for ", $MBI->_str($x),"\n";
  2570. #  print "a=",$MBI->_str($a),"\n"; print "b=",$MBI->_str($b),"\n";
  2571.   # return a/b so that a/b approximates atan(1/x)
  2572.   ($a,$b);
  2573.   }
  2574.  
  2575. sub bpi
  2576.   {
  2577.   my ($self,$n) = @_;
  2578.   if (@_ == 0)
  2579.     {
  2580.     $self = $class;
  2581.     }
  2582.   if (@_ == 1)
  2583.     {
  2584.     # called like Math::BigFloat::bpi(10);
  2585.     $n = $self; $self = $class;
  2586.     # called like Math::BigFloat->bpi();
  2587.     $n = undef if $n eq 'Math::BigFloat';
  2588.     }
  2589.   $self = ref($self) if ref($self);
  2590.   my $fallback = defined $n ? 0 : 1;
  2591.   $n = 40 if !defined $n || $n < 1;
  2592.  
  2593.   # after ÃˆÂªÃ‰Ã‹Â¶Ã£Ã‚à© (Hwang Chien-Lih) (1997)
  2594.   # pi/4 = 183 * atan(1/239) + 32 * atan(1/1023) â€šÃ„ì 68 * atan(1/5832)
  2595.   #     + 12 * atan(1/110443) - 12 * atan(1/4841182) - 100 * atan(1/6826318)
  2596.  
  2597.   # a few more to prevent rounding errors
  2598.   $n += 4;
  2599.  
  2600.   my ($a,$b) = $self->_atan_inv( $MBI->_new(239),$n);
  2601.   my ($c,$d) = $self->_atan_inv( $MBI->_new(1023),$n);
  2602.   my ($e,$f) = $self->_atan_inv( $MBI->_new(5832),$n);
  2603.   my ($g,$h) = $self->_atan_inv( $MBI->_new(110443),$n);
  2604.   my ($i,$j) = $self->_atan_inv( $MBI->_new(4841182),$n);
  2605.   my ($k,$l) = $self->_atan_inv( $MBI->_new(6826318),$n);
  2606.  
  2607.   $MBI->_mul($a, $MBI->_new(732));
  2608.   $MBI->_mul($c, $MBI->_new(128));
  2609.   $MBI->_mul($e, $MBI->_new(272));
  2610.   $MBI->_mul($g, $MBI->_new(48));
  2611.   $MBI->_mul($i, $MBI->_new(48));
  2612.   $MBI->_mul($k, $MBI->_new(400));
  2613.  
  2614.   my $x = $self->bone(); $x->{_m} = $a; my $x_d = $self->bone(); $x_d->{_m} = $b;
  2615.   my $y = $self->bone(); $y->{_m} = $c; my $y_d = $self->bone(); $y_d->{_m} = $d;
  2616.   my $z = $self->bone(); $z->{_m} = $e; my $z_d = $self->bone(); $z_d->{_m} = $f;
  2617.   my $u = $self->bone(); $u->{_m} = $g; my $u_d = $self->bone(); $u_d->{_m} = $h;
  2618.   my $v = $self->bone(); $v->{_m} = $i; my $v_d = $self->bone(); $v_d->{_m} = $j;
  2619.   my $w = $self->bone(); $w->{_m} = $k; my $w_d = $self->bone(); $w_d->{_m} = $l;
  2620.   $x->bdiv($x_d, $n);
  2621.   $y->bdiv($y_d, $n);
  2622.   $z->bdiv($z_d, $n);
  2623.   $u->bdiv($u_d, $n);
  2624.   $v->bdiv($v_d, $n);
  2625.   $w->bdiv($w_d, $n);
  2626.  
  2627.   delete $x->{_a}; delete $y->{_a}; delete $z->{_a};
  2628.   delete $u->{_a}; delete $v->{_a}; delete $w->{_a};
  2629.   $x->badd($y)->bsub($z)->badd($u)->bsub($v)->bsub($w);
  2630.  
  2631.   $x->bround($n-4);
  2632.   delete $x->{_a} if $fallback == 1;
  2633.   $x;
  2634.   }
  2635.  
  2636. sub bcos
  2637.   {
  2638.   # Calculate a cosinus of x.
  2639.   my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
  2640.  
  2641.   # Taylor:      x^2   x^4   x^6   x^8
  2642.   #    cos = 1 - --- + --- - --- + --- ...
  2643.   #               2!    4!    6!    8!
  2644.  
  2645.   # we need to limit the accuracy to protect against overflow
  2646.   my $fallback = 0;
  2647.   my ($scale,@params);
  2648.   ($x,@params) = $x->_find_round_parameters(@r);
  2649.     
  2650.   #         constant object       or error in _find_round_parameters?
  2651.   return $x if $x->modify('bcos') || $x->is_nan();
  2652.  
  2653.   return $x->bone(@r) if $x->is_zero();
  2654.  
  2655.   # no rounding at all, so must use fallback
  2656.   if (scalar @params == 0)
  2657.     {
  2658.     # simulate old behaviour
  2659.     $params[0] = $self->div_scale();    # and round to it as accuracy
  2660.     $params[1] = undef;            # disable P
  2661.     $scale = $params[0]+4;         # at least four more for proper round
  2662.     $params[2] = $r[2];            # round mode by caller or undef
  2663.     $fallback = 1;            # to clear a/p afterwards
  2664.     }
  2665.   else
  2666.     {
  2667.     # the 4 below is empirical, and there might be cases where it is not
  2668.     # enough...
  2669.     $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
  2670.     }
  2671.  
  2672.   # when user set globals, they would interfere with our calculation, so
  2673.   # disable them and later re-enable them
  2674.   no strict 'refs';
  2675.   my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef;
  2676.   my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef;
  2677.   # we also need to disable any set A or P on $x (_find_round_parameters took
  2678.   # them already into account), since these would interfere, too
  2679.   delete $x->{_a}; delete $x->{_p};
  2680.   # need to disable $upgrade in BigInt, to avoid deep recursion
  2681.   local $Math::BigInt::upgrade = undef;
  2682.  
  2683.   my $last = 0;
  2684.   my $over = $x * $x;                   # X ^ 2
  2685.   my $x2 = $over->copy();               # X ^ 2; difference between terms
  2686.   my $sign = 1;                         # start with -=
  2687.   my $below = $self->new(2); my $factorial = $self->new(3);
  2688.   $x->bone(); delete $x->{_a}; delete $x->{_p};
  2689.  
  2690.   my $limit = $self->new("1E-". ($scale-1));
  2691.   #my $steps = 0;
  2692.   while (3 < 5)
  2693.     {
  2694.     # we calculate the next term, and add it to the last
  2695.     # when the next term is below our limit, it won't affect the outcome
  2696.     # anymore, so we stop:
  2697.     my $next = $over->copy()->bdiv($below,$scale);
  2698.     last if $next->bacmp($limit) <= 0;
  2699.  
  2700.     if ($sign == 0)
  2701.       {
  2702.       $x->badd($next);
  2703.       }
  2704.     else
  2705.       {
  2706.       $x->bsub($next);
  2707.       }
  2708.     $sign = 1-$sign;                    # alternate
  2709.     # calculate things for the next term
  2710.     $over->bmul($x2);                    # $x*$x
  2711.     $below->bmul($factorial); $factorial->binc();    # n*(n+1)
  2712.     $below->bmul($factorial); $factorial->binc();    # n*(n+1)
  2713.     }
  2714.  
  2715.   # shortcut to not run through _find_round_parameters again
  2716.   if (defined $params[0])
  2717.     {
  2718.     $x->bround($params[0],$params[2]);        # then round accordingly
  2719.     }
  2720.   else
  2721.     {
  2722.     $x->bfround($params[1],$params[2]);        # then round accordingly
  2723.     }
  2724.   if ($fallback)
  2725.     {
  2726.     # clear a/p after round, since user did not request it
  2727.     delete $x->{_a}; delete $x->{_p};
  2728.     }
  2729.   # restore globals
  2730.   $$abr = $ab; $$pbr = $pb;
  2731.   $x;
  2732.   }
  2733.  
  2734. sub bsin
  2735.   {
  2736.   # Calculate a sinus of x.
  2737.   my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
  2738.  
  2739.   # taylor:      x^3   x^5   x^7   x^9
  2740.   #    sin = x - --- + --- - --- + --- ...
  2741.   #               3!    5!    7!    9!
  2742.  
  2743.   # we need to limit the accuracy to protect against overflow
  2744.   my $fallback = 0;
  2745.   my ($scale,@params);
  2746.   ($x,@params) = $x->_find_round_parameters(@r);
  2747.     
  2748.   #         constant object       or error in _find_round_parameters?
  2749.   return $x if $x->modify('bsin') || $x->is_nan();
  2750.  
  2751.   return $x->bzero(@r) if $x->is_zero();
  2752.  
  2753.   # no rounding at all, so must use fallback
  2754.   if (scalar @params == 0)
  2755.     {
  2756.     # simulate old behaviour
  2757.     $params[0] = $self->div_scale();    # and round to it as accuracy
  2758.     $params[1] = undef;            # disable P
  2759.     $scale = $params[0]+4;         # at least four more for proper round
  2760.     $params[2] = $r[2];            # round mode by caller or undef
  2761.     $fallback = 1;            # to clear a/p afterwards
  2762.     }
  2763.   else
  2764.     {
  2765.     # the 4 below is empirical, and there might be cases where it is not
  2766.     # enough...
  2767.     $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
  2768.     }
  2769.  
  2770.   # when user set globals, they would interfere with our calculation, so
  2771.   # disable them and later re-enable them
  2772.   no strict 'refs';
  2773.   my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef;
  2774.   my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef;
  2775.   # we also need to disable any set A or P on $x (_find_round_parameters took
  2776.   # them already into account), since these would interfere, too
  2777.   delete $x->{_a}; delete $x->{_p};
  2778.   # need to disable $upgrade in BigInt, to avoid deep recursion
  2779.   local $Math::BigInt::upgrade = undef;
  2780.  
  2781.   my $last = 0;
  2782.   my $over = $x * $x;            # X ^ 2
  2783.   my $x2 = $over->copy();        # X ^ 2; difference between terms
  2784.   $over->bmul($x);            # X ^ 3 as starting value
  2785.   my $sign = 1;                # start with -=
  2786.   my $below = $self->new(6); my $factorial = $self->new(4);
  2787.   delete $x->{_a}; delete $x->{_p};
  2788.  
  2789.   my $limit = $self->new("1E-". ($scale-1));
  2790.   #my $steps = 0;
  2791.   while (3 < 5)
  2792.     {
  2793.     # we calculate the next term, and add it to the last
  2794.     # when the next term is below our limit, it won't affect the outcome
  2795.     # anymore, so we stop:
  2796.     my $next = $over->copy()->bdiv($below,$scale);
  2797.     last if $next->bacmp($limit) <= 0;
  2798.  
  2799.     if ($sign == 0)
  2800.       {
  2801.       $x->badd($next);
  2802.       }
  2803.     else
  2804.       {
  2805.       $x->bsub($next);
  2806.       }
  2807.     $sign = 1-$sign;                    # alternate
  2808.     # calculate things for the next term
  2809.     $over->bmul($x2);                    # $x*$x
  2810.     $below->bmul($factorial); $factorial->binc();    # n*(n+1)
  2811.     $below->bmul($factorial); $factorial->binc();    # n*(n+1)
  2812.     }
  2813.  
  2814.   # shortcut to not run through _find_round_parameters again
  2815.   if (defined $params[0])
  2816.     {
  2817.     $x->bround($params[0],$params[2]);        # then round accordingly
  2818.     }
  2819.   else
  2820.     {
  2821.     $x->bfround($params[1],$params[2]);        # then round accordingly
  2822.     }
  2823.   if ($fallback)
  2824.     {
  2825.     # clear a/p after round, since user did not request it
  2826.     delete $x->{_a}; delete $x->{_p};
  2827.     }
  2828.   # restore globals
  2829.   $$abr = $ab; $$pbr = $pb;
  2830.   $x;
  2831.   }
  2832.  
  2833. sub batan2
  2834.   { 
  2835.   # calculate arcus tangens of ($y/$x)
  2836.   
  2837.   # set up parameters
  2838.   my ($self,$y,$x,@r) = (ref($_[0]),@_);
  2839.   # objectify is costly, so avoid it
  2840.   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
  2841.     {
  2842.     ($self,$y,$x,@r) = objectify(2,@_);
  2843.     }
  2844.  
  2845.   return $y if $y->modify('batan2');
  2846.  
  2847.   return $y->bnan() if ($y->{sign} eq $nan) || ($x->{sign} eq $nan);
  2848.  
  2849.   return $upgrade->new($y)->batan2($upgrade->new($x),@r) if defined $upgrade;
  2850.  
  2851.   # Y X
  2852.   # 0 0 result is 0
  2853.   # 0 +x result is 0
  2854.   return $y->bzero(@r) if $y->is_zero() && $x->{sign} eq '+';
  2855.  
  2856.   # Y X
  2857.   # 0 -x result is PI
  2858.   if ($y->is_zero())
  2859.     {
  2860.     # calculate PI
  2861.     my $pi = $self->bpi(@r);
  2862.     # modify $x in place
  2863.     $y->{_m} = $pi->{_m};
  2864.     $y->{_e} = $pi->{_e};
  2865.     $y->{_es} = $pi->{_es};
  2866.     $y->{sign} = '+';
  2867.     return $y;
  2868.     }
  2869.  
  2870.   # Y X
  2871.   # +y 0 result is PI/2
  2872.   # -y 0 result is -PI/2
  2873.   if ($y->is_inf() || $x->is_zero())
  2874.     {
  2875.     # calculate PI/2
  2876.     my $pi = $self->bpi(@r);
  2877.     # modify $x in place
  2878.     $y->{_m} = $pi->{_m};
  2879.     $y->{_e} = $pi->{_e};
  2880.     $y->{_es} = $pi->{_es};
  2881.     # -y => -PI/2, +y => PI/2
  2882.     $y->{sign} = substr($y->{sign},0,1);        # +inf => +
  2883.     $MBI->_div($y->{_m}, $MBI->_new(2));
  2884.     return $y;
  2885.     }
  2886.  
  2887.   # we need to limit the accuracy to protect against overflow
  2888.   my $fallback = 0;
  2889.   my ($scale,@params);
  2890.   ($y,@params) = $y->_find_round_parameters(@r);
  2891.     
  2892.   # error in _find_round_parameters?
  2893.   return $y if $y->is_nan();
  2894.  
  2895.   # no rounding at all, so must use fallback
  2896.   if (scalar @params == 0)
  2897.     {
  2898.     # simulate old behaviour
  2899.     $params[0] = $self->div_scale();    # and round to it as accuracy
  2900.     $params[1] = undef;            # disable P
  2901.     $scale = $params[0]+4;         # at least four more for proper round
  2902.     $params[2] = $r[2];            # round mode by caller or undef
  2903.     $fallback = 1;            # to clear a/p afterwards
  2904.     }
  2905.   else
  2906.     {
  2907.     # the 4 below is empirical, and there might be cases where it is not
  2908.     # enough...
  2909.     $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
  2910.     }
  2911.  
  2912.   # inlined is_one() && is_one('-')
  2913.   if ($MBI->_is_one($y->{_m}) && $MBI->_is_zero($y->{_e}))
  2914.     {
  2915.     # shortcut: 1 1 result is PI/4
  2916.     # inlined is_one() && is_one('-')
  2917.     if ($MBI->_is_one($x->{_m}) && $MBI->_is_zero($x->{_e}))
  2918.       {
  2919.       # 1,1 => PI/4
  2920.       my $pi_4 = $self->bpi( $scale - 3);
  2921.       # modify $x in place
  2922.       $y->{_m} = $pi_4->{_m};
  2923.       $y->{_e} = $pi_4->{_e};
  2924.       $y->{_es} = $pi_4->{_es};
  2925.       # 1 1 => +
  2926.       # -1 1 => -
  2927.       # 1 -1 => -
  2928.       # -1 -1 => +
  2929.       $y->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-';
  2930.       $MBI->_div($y->{_m}, $MBI->_new(4));
  2931.       return $y;
  2932.       }
  2933.     # shortcut: 1 int(X) result is _atan_inv(X)
  2934.  
  2935.     # is integer
  2936.     if ($x->{_es} eq '+')
  2937.       {
  2938.       my $x1 = $MBI->_copy($x->{_m});
  2939.       $MBI->_lsft($x1, $x->{_e},10) unless $MBI->_is_zero($x->{_e});
  2940.  
  2941.       my ($a,$b) = $self->_atan_inv($x1, $scale);
  2942.       my $y_sign = $y->{sign};
  2943.       # calculate A/B
  2944.       $y->bone(); $y->{_m} = $a; my $y_d = $self->bone(); $y_d->{_m} = $b;
  2945.       $y->bdiv($y_d, @r);
  2946.       $y->{sign} = $y_sign;
  2947.       return $y;
  2948.       }
  2949.     }
  2950.  
  2951.   # handle all other cases
  2952.   #  X  Y
  2953.   # +x +y 0 to PI/2
  2954.   # -x +y PI/2 to PI
  2955.   # +x -y 0 to -PI/2
  2956.   # -x -y -PI/2 to -PI 
  2957.  
  2958.   my $y_sign = $y->{sign};
  2959.  
  2960.   # divide $x by $y
  2961.   $y->bdiv($x, $scale) unless $x->is_one();
  2962.   $y->batan(@r);
  2963.  
  2964.   # restore sign
  2965.   $y->{sign} = $y_sign;
  2966.  
  2967.   $y;
  2968.   }
  2969.  
  2970. sub batan
  2971.   {
  2972.   # Calculate a arcus tangens of x.
  2973.   my ($x,@r) = @_;
  2974.   my $self = ref($x);
  2975.  
  2976.   # taylor:       x^3   x^5   x^7   x^9
  2977.   #    atan = x - --- + --- - --- + --- ...
  2978.   #                3     5     7     9 
  2979.  
  2980.   # we need to limit the accuracy to protect against overflow
  2981.   my $fallback = 0;
  2982.   my ($scale,@params);
  2983.   ($x,@params) = $x->_find_round_parameters(@r);
  2984.     
  2985.   #         constant object       or error in _find_round_parameters?
  2986.   return $x if $x->modify('batan') || $x->is_nan();
  2987.  
  2988.   if ($x->{sign} =~ /^[+-]inf\z/)
  2989.     {
  2990.     # +inf result is PI/2
  2991.     # -inf result is -PI/2
  2992.     # calculate PI/2
  2993.     my $pi = $self->bpi(@r);
  2994.     # modify $x in place
  2995.     $x->{_m} = $pi->{_m};
  2996.     $x->{_e} = $pi->{_e};
  2997.     $x->{_es} = $pi->{_es};
  2998.     # -y => -PI/2, +y => PI/2
  2999.     $x->{sign} = substr($x->{sign},0,1);        # +inf => +
  3000.     $MBI->_div($x->{_m}, $MBI->_new(2));
  3001.     return $x;
  3002.     }
  3003.  
  3004.   return $x->bzero(@r) if $x->is_zero();
  3005.  
  3006.   # no rounding at all, so must use fallback
  3007.   if (scalar @params == 0)
  3008.     {
  3009.     # simulate old behaviour
  3010.     $params[0] = $self->div_scale();    # and round to it as accuracy
  3011.     $params[1] = undef;            # disable P
  3012.     $scale = $params[0]+4;         # at least four more for proper round
  3013.     $params[2] = $r[2];            # round mode by caller or undef
  3014.     $fallback = 1;            # to clear a/p afterwards
  3015.     }
  3016.   else
  3017.     {
  3018.     # the 4 below is empirical, and there might be cases where it is not
  3019.     # enough...
  3020.     $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
  3021.     }
  3022.  
  3023.   # 1 or -1 => PI/4
  3024.   # inlined is_one() && is_one('-')
  3025.   if ($MBI->_is_one($x->{_m}) && $MBI->_is_zero($x->{_e}))
  3026.     {
  3027.     my $pi = $self->bpi($scale - 3);
  3028.     # modify $x in place
  3029.     $x->{_m} = $pi->{_m};
  3030.     $x->{_e} = $pi->{_e};
  3031.     $x->{_es} = $pi->{_es};
  3032.     # leave the sign of $x alone (+1 => +PI/4, -1 => -PI/4)
  3033.     $MBI->_div($x->{_m}, $MBI->_new(4));
  3034.     return $x;
  3035.     }
  3036.   
  3037.   # This series is only valid if -1 < x < 1, so for other x we need to
  3038.   # to calculate PI/2 - atan(1/x):
  3039.   my $one = $MBI->_new(1);
  3040.   my $pi = undef;
  3041.   if ($x->{_es} eq '+' && ($MBI->_acmp($x->{_m},$one) >= 0))
  3042.     {
  3043.     # calculate PI/2
  3044.     $pi = $self->bpi($scale - 3);
  3045.     $MBI->_div($pi->{_m}, $MBI->_new(2));
  3046.     # calculate 1/$x:
  3047.     my $x_copy = $x->copy();
  3048.     # modify $x in place
  3049.     $x->bone(); $x->bdiv($x_copy,$scale);
  3050.     }
  3051.  
  3052.   # when user set globals, they would interfere with our calculation, so
  3053.   # disable them and later re-enable them
  3054.   no strict 'refs';
  3055.   my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef;
  3056.   my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef;
  3057.   # we also need to disable any set A or P on $x (_find_round_parameters took
  3058.   # them already into account), since these would interfere, too
  3059.   delete $x->{_a}; delete $x->{_p};
  3060.   # need to disable $upgrade in BigInt, to avoid deep recursion
  3061.   local $Math::BigInt::upgrade = undef;
  3062.  
  3063.   my $last = 0;
  3064.   my $over = $x * $x;            # X ^ 2
  3065.   my $x2 = $over->copy();        # X ^ 2; difference between terms
  3066.   $over->bmul($x);            # X ^ 3 as starting value
  3067.   my $sign = 1;                # start with -=
  3068.   my $below = $self->new(3);
  3069.   my $two = $self->new(2);
  3070.   delete $x->{_a}; delete $x->{_p};
  3071.  
  3072.   my $limit = $self->new("1E-". ($scale-1));
  3073.   #my $steps = 0;
  3074.   while (3 < 5)
  3075.     {
  3076.     # we calculate the next term, and add it to the last
  3077.     # when the next term is below our limit, it won't affect the outcome
  3078.     # anymore, so we stop:
  3079.     my $next = $over->copy()->bdiv($below,$scale);
  3080.     last if $next->bacmp($limit) <= 0;
  3081.  
  3082.     if ($sign == 0)
  3083.       {
  3084.       $x->badd($next);
  3085.       }
  3086.     else
  3087.       {
  3088.       $x->bsub($next);
  3089.       }
  3090.     $sign = 1-$sign;                    # alternate
  3091.     # calculate things for the next term
  3092.     $over->bmul($x2);                    # $x*$x
  3093.     $below->badd($two);                    # n += 2
  3094.     }
  3095.  
  3096.   if (defined $pi)
  3097.     {
  3098.     my $x_copy = $x->copy();
  3099.     # modify $x in place
  3100.     $x->{_m} = $pi->{_m};
  3101.     $x->{_e} = $pi->{_e};
  3102.     $x->{_es} = $pi->{_es};
  3103.     # PI/2 - $x
  3104.     $x->bsub($x_copy);
  3105.     }
  3106.  
  3107.   # shortcut to not run through _find_round_parameters again
  3108.   if (defined $params[0])
  3109.     {
  3110.     $x->bround($params[0],$params[2]);        # then round accordingly
  3111.     }
  3112.   else
  3113.     {
  3114.     $x->bfround($params[1],$params[2]);        # then round accordingly
  3115.     }
  3116.   if ($fallback)
  3117.     {
  3118.     # clear a/p after round, since user did not request it
  3119.     delete $x->{_a}; delete $x->{_p};
  3120.     }
  3121.   # restore globals
  3122.   $$abr = $ab; $$pbr = $pb;
  3123.   $x;
  3124.   }
  3125.  
  3126. ###############################################################################
  3127. # rounding functions
  3128.  
  3129. sub bfround
  3130.   {
  3131.   # precision: round to the $Nth digit left (+$n) or right (-$n) from the '.'
  3132.   # $n == 0 means round to integer
  3133.   # expects and returns normalized numbers!
  3134.   my $x = shift; my $self = ref($x) || $x; $x = $self->new(shift) if !ref($x);
  3135.  
  3136.   my ($scale,$mode) = $x->_scale_p(@_);
  3137.   return $x if !defined $scale || $x->modify('bfround'); # no-op
  3138.  
  3139.   # never round a 0, +-inf, NaN
  3140.   if ($x->is_zero())
  3141.     {
  3142.     $x->{_p} = $scale if !defined $x->{_p} || $x->{_p} < $scale; # -3 < -2
  3143.     return $x; 
  3144.     }
  3145.   return $x if $x->{sign} !~ /^[+-]$/;
  3146.  
  3147.   # don't round if x already has lower precision
  3148.   return $x if (defined $x->{_p} && $x->{_p} < 0 && $scale < $x->{_p});
  3149.  
  3150.   $x->{_p} = $scale;            # remember round in any case
  3151.   delete $x->{_a};            # and clear A
  3152.   if ($scale < 0)
  3153.     {
  3154.     # round right from the '.'
  3155.  
  3156.     return $x if $x->{_es} eq '+';        # e >= 0 => nothing to round
  3157.  
  3158.     $scale = -$scale;                # positive for simplicity
  3159.     my $len = $MBI->_len($x->{_m});        # length of mantissa
  3160.  
  3161.     # the following poses a restriction on _e, but if _e is bigger than a
  3162.     # scalar, you got other problems (memory etc) anyway
  3163.     my $dad = -(0+ ($x->{_es}.$MBI->_num($x->{_e})));    # digits after dot
  3164.     my $zad = 0;                # zeros after dot
  3165.     $zad = $dad - $len if (-$dad < -$len);    # for 0.00..00xxx style
  3166.    
  3167.     # p rint "scale $scale dad $dad zad $zad len $len\n";
  3168.     # number  bsstr   len zad dad    
  3169.     # 0.123   123e-3    3   0 3
  3170.     # 0.0123  123e-4    3   1 4
  3171.     # 0.001   1e-3      1   2 3
  3172.     # 1.23    123e-2    3   0 2
  3173.     # 1.2345  12345e-4    5   0 4
  3174.  
  3175.     # do not round after/right of the $dad
  3176.     return $x if $scale > $dad;            # 0.123, scale >= 3 => exit
  3177.  
  3178.     # round to zero if rounding inside the $zad, but not for last zero like:
  3179.     # 0.0065, scale -2, round last '0' with following '65' (scale == zad case)
  3180.     return $x->bzero() if $scale < $zad;
  3181.     if ($scale == $zad)            # for 0.006, scale -3 and trunc
  3182.       {
  3183.       $scale = -$len;
  3184.       }
  3185.     else
  3186.       {
  3187.       # adjust round-point to be inside mantissa
  3188.       if ($zad != 0)
  3189.         {
  3190.     $scale = $scale-$zad;
  3191.         }
  3192.       else
  3193.         {
  3194.         my $dbd = $len - $dad; $dbd = 0 if $dbd < 0;    # digits before dot
  3195.     $scale = $dbd+$scale;
  3196.         }
  3197.       }
  3198.     }
  3199.   else
  3200.     {
  3201.     # round left from the '.'
  3202.  
  3203.     # 123 => 100 means length(123) = 3 - $scale (2) => 1
  3204.  
  3205.     my $dbt = $MBI->_len($x->{_m}); 
  3206.     # digits before dot 
  3207.     my $dbd = $dbt + ($x->{_es} . $MBI->_num($x->{_e}));
  3208.     # should be the same, so treat it as this 
  3209.     $scale = 1 if $scale == 0; 
  3210.     # shortcut if already integer 
  3211.     return $x if $scale == 1 && $dbt <= $dbd; 
  3212.     # maximum digits before dot 
  3213.     ++$dbd;
  3214.  
  3215.     if ($scale > $dbd) 
  3216.        { 
  3217.        # not enough digits before dot, so round to zero 
  3218.        return $x->bzero; 
  3219.        }
  3220.     elsif ( $scale == $dbd )
  3221.        { 
  3222.        # maximum 
  3223.        $scale = -$dbt; 
  3224.        } 
  3225.     else
  3226.        { 
  3227.        $scale = $dbd - $scale; 
  3228.        }
  3229.     }
  3230.   # pass sign to bround for rounding modes '+inf' and '-inf'
  3231.   my $m = bless { sign => $x->{sign}, value => $x->{_m} }, 'Math::BigInt';
  3232.   $m->bround($scale,$mode);
  3233.   $x->{_m} = $m->{value};            # get our mantissa back
  3234.   $x->bnorm();
  3235.   }
  3236.  
  3237. sub bround
  3238.   {
  3239.   # accuracy: preserve $N digits, and overwrite the rest with 0's
  3240.   my $x = shift; my $self = ref($x) || $x; $x = $self->new(shift) if !ref($x);
  3241.  
  3242.   if (($_[0] || 0) < 0)
  3243.     {
  3244.     require Carp; Carp::croak ('bround() needs positive accuracy');
  3245.     }
  3246.  
  3247.   my ($scale,$mode) = $x->_scale_a(@_);
  3248.   return $x if !defined $scale || $x->modify('bround');    # no-op
  3249.  
  3250.   # scale is now either $x->{_a}, $accuracy, or the user parameter
  3251.   # test whether $x already has lower accuracy, do nothing in this case 
  3252.   # but do round if the accuracy is the same, since a math operation might
  3253.   # want to round a number with A=5 to 5 digits afterwards again
  3254.   return $x if defined $x->{_a} && $x->{_a} < $scale;
  3255.  
  3256.   # scale < 0 makes no sense
  3257.   # scale == 0 => keep all digits
  3258.   # never round a +-inf, NaN
  3259.   return $x if ($scale <= 0) || $x->{sign} !~ /^[+-]$/;
  3260.  
  3261.   # 1: never round a 0
  3262.   # 2: if we should keep more digits than the mantissa has, do nothing
  3263.   if ($x->is_zero() || $MBI->_len($x->{_m}) <= $scale)
  3264.     {
  3265.     $x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale;
  3266.     return $x; 
  3267.     }
  3268.  
  3269.   # pass sign to bround for '+inf' and '-inf' rounding modes
  3270.   my $m = bless { sign => $x->{sign}, value => $x->{_m} }, 'Math::BigInt';
  3271.  
  3272.   $m->bround($scale,$mode);        # round mantissa
  3273.   $x->{_m} = $m->{value};        # get our mantissa back
  3274.   $x->{_a} = $scale;            # remember rounding
  3275.   delete $x->{_p};            # and clear P
  3276.   $x->bnorm();                # del trailing zeros gen. by bround()
  3277.   }
  3278.  
  3279. sub bfloor
  3280.   {
  3281.   # return integer less or equal then $x
  3282.   my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
  3283.  
  3284.   return $x if $x->modify('bfloor');
  3285.    
  3286.   return $x if $x->{sign} !~ /^[+-]$/;    # nan, +inf, -inf
  3287.  
  3288.   # if $x has digits after dot
  3289.   if ($x->{_es} eq '-')
  3290.     {
  3291.     $x->{_m} = $MBI->_rsft($x->{_m},$x->{_e},10); # cut off digits after dot
  3292.     $x->{_e} = $MBI->_zero();            # trunc/norm    
  3293.     $x->{_es} = '+';                # abs e
  3294.     $MBI->_inc($x->{_m}) if $x->{sign} eq '-';    # increment if negative
  3295.     }
  3296.   $x->round($a,$p,$r);
  3297.   }
  3298.  
  3299. sub bceil
  3300.   {
  3301.   # return integer greater or equal then $x
  3302.   my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
  3303.  
  3304.   return $x if $x->modify('bceil');
  3305.   return $x if $x->{sign} !~ /^[+-]$/;    # nan, +inf, -inf
  3306.  
  3307.   # if $x has digits after dot
  3308.   if ($x->{_es} eq '-')
  3309.     {
  3310.     $x->{_m} = $MBI->_rsft($x->{_m},$x->{_e},10); # cut off digits after dot
  3311.     $x->{_e} = $MBI->_zero();            # trunc/norm    
  3312.     $x->{_es} = '+';                # abs e
  3313.     $MBI->_inc($x->{_m}) if $x->{sign} eq '+';    # increment if positive
  3314.     }
  3315.   $x->round($a,$p,$r);
  3316.   }
  3317.  
  3318. sub brsft
  3319.   {
  3320.   # shift right by $y (divide by power of $n)
  3321.   
  3322.   # set up parameters
  3323.   my ($self,$x,$y,$n,$a,$p,$r) = (ref($_[0]),@_);
  3324.   # objectify is costly, so avoid it
  3325.   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
  3326.     {
  3327.     ($self,$x,$y,$n,$a,$p,$r) = objectify(2,@_);
  3328.     }
  3329.  
  3330.   return $x if $x->modify('brsft');
  3331.   return $x if $x->{sign} !~ /^[+-]$/;    # nan, +inf, -inf
  3332.  
  3333.   $n = 2 if !defined $n; $n = $self->new($n);
  3334.  
  3335.   # negative amount?
  3336.   return $x->blsft($y->copy()->babs(),$n) if $y->{sign} =~ /^-/;
  3337.  
  3338.   # the following call to bdiv() will return either quo or (quo,reminder):
  3339.   $x->bdiv($n->bpow($y),$a,$p,$r,$y);
  3340.   }
  3341.  
  3342. sub blsft
  3343.   {
  3344.   # shift left by $y (multiply by power of $n)
  3345.   
  3346.   # set up parameters
  3347.   my ($self,$x,$y,$n,$a,$p,$r) = (ref($_[0]),@_);
  3348.   # objectify is costly, so avoid it
  3349.   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
  3350.     {
  3351.     ($self,$x,$y,$n,$a,$p,$r) = objectify(2,@_);
  3352.     }
  3353.  
  3354.   return $x if $x->modify('blsft');
  3355.   return $x if $x->{sign} !~ /^[+-]$/;    # nan, +inf, -inf
  3356.  
  3357.   $n = 2 if !defined $n; $n = $self->new($n);
  3358.  
  3359.   # negative amount?
  3360.   return $x->brsft($y->copy()->babs(),$n) if $y->{sign} =~ /^-/;
  3361.  
  3362.   $x->bmul($n->bpow($y),$a,$p,$r,$y);
  3363.   }
  3364.  
  3365. ###############################################################################
  3366.  
  3367. sub DESTROY
  3368.   {
  3369.   # going through AUTOLOAD for every DESTROY is costly, avoid it by empty sub
  3370.   }
  3371.  
  3372. sub AUTOLOAD
  3373.   {
  3374.   # make fxxx and bxxx both work by selectively mapping fxxx() to MBF::bxxx()
  3375.   # or falling back to MBI::bxxx()
  3376.   my $name = $AUTOLOAD;
  3377.  
  3378.   $name =~ s/(.*):://;    # split package
  3379.   my $c = $1 || $class;
  3380.   no strict 'refs';
  3381.   $c->import() if $IMPORT == 0;
  3382.   if (!_method_alias($name))
  3383.     {
  3384.     if (!defined $name)
  3385.       {
  3386.       # delayed load of Carp and avoid recursion    
  3387.       require Carp;
  3388.       Carp::croak ("$c: Can't call a method without name");
  3389.       }
  3390.     if (!_method_hand_up($name))
  3391.       {
  3392.       # delayed load of Carp and avoid recursion    
  3393.       require Carp;
  3394.       Carp::croak ("Can't call $c\-\>$name, not a valid method");
  3395.       }
  3396.     # try one level up, but subst. bxxx() for fxxx() since MBI only got bxxx()
  3397.     $name =~ s/^f/b/;
  3398.     return &{"Math::BigInt"."::$name"}(@_);
  3399.     }
  3400.   my $bname = $name; $bname =~ s/^f/b/;
  3401.   $c .= "::$name";
  3402.   *{$c} = \&{$bname};
  3403.   &{$c};    # uses @_
  3404.   }
  3405.  
  3406. sub exponent
  3407.   {
  3408.   # return a copy of the exponent
  3409.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  3410.  
  3411.   if ($x->{sign} !~ /^[+-]$/)
  3412.     {
  3413.     my $s = $x->{sign}; $s =~ s/^[+-]//;
  3414.     return Math::BigInt->new($s);         # -inf, +inf => +inf
  3415.     }
  3416.   Math::BigInt->new( $x->{_es} . $MBI->_str($x->{_e}));
  3417.   }
  3418.  
  3419. sub mantissa
  3420.   {
  3421.   # return a copy of the mantissa
  3422.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  3423.  
  3424.   if ($x->{sign} !~ /^[+-]$/)
  3425.     {
  3426.     my $s = $x->{sign}; $s =~ s/^[+]//;
  3427.     return Math::BigInt->new($s);        # -inf, +inf => +inf
  3428.     }
  3429.   my $m = Math::BigInt->new( $MBI->_str($x->{_m}));
  3430.   $m->bneg() if $x->{sign} eq '-';
  3431.  
  3432.   $m;
  3433.   }
  3434.  
  3435. sub parts
  3436.   {
  3437.   # return a copy of both the exponent and the mantissa
  3438.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  3439.  
  3440.   if ($x->{sign} !~ /^[+-]$/)
  3441.     {
  3442.     my $s = $x->{sign}; $s =~ s/^[+]//; my $se = $s; $se =~ s/^[-]//;
  3443.     return ($self->new($s),$self->new($se)); # +inf => inf and -inf,+inf => inf
  3444.     }
  3445.   my $m = Math::BigInt->bzero();
  3446.   $m->{value} = $MBI->_copy($x->{_m});
  3447.   $m->bneg() if $x->{sign} eq '-';
  3448.   ($m, Math::BigInt->new( $x->{_es} . $MBI->_num($x->{_e}) ));
  3449.   }
  3450.  
  3451. ##############################################################################
  3452. # private stuff (internal use only)
  3453.  
  3454. sub import
  3455.   {
  3456.   my $self = shift;
  3457.   my $l = scalar @_;
  3458.   my $lib = ''; my @a;
  3459.   my $lib_kind = 'try';
  3460.   $IMPORT=1;
  3461.   for ( my $i = 0; $i < $l ; $i++)
  3462.     {
  3463.     if ( $_[$i] eq ':constant' )
  3464.       {
  3465.       # This causes overlord er load to step in. 'binary' and 'integer'
  3466.       # are handled by BigInt.
  3467.       overload::constant float => sub { $self->new(shift); }; 
  3468.       }
  3469.     elsif ($_[$i] eq 'upgrade')
  3470.       {
  3471.       # this causes upgrading
  3472.       $upgrade = $_[$i+1];        # or undef to disable
  3473.       $i++;
  3474.       }
  3475.     elsif ($_[$i] eq 'downgrade')
  3476.       {
  3477.       # this causes downgrading
  3478.       $downgrade = $_[$i+1];        # or undef to disable
  3479.       $i++;
  3480.       }
  3481.     elsif ($_[$i] =~ /^(lib|try|only)\z/)
  3482.       {
  3483.       # alternative library
  3484.       $lib = $_[$i+1] || '';        # default Calc
  3485.       $lib_kind = $1;            # lib, try or only
  3486.       $i++;
  3487.       }
  3488.     elsif ($_[$i] eq 'with')
  3489.       {
  3490.       # alternative class for our private parts()
  3491.       # XXX: no longer supported
  3492.       # $MBI = $_[$i+1] || 'Math::BigInt';
  3493.       $i++;
  3494.       }
  3495.     else
  3496.       {
  3497.       push @a, $_[$i];
  3498.       }
  3499.     }
  3500.  
  3501.   $lib =~ tr/a-zA-Z0-9,://cd;        # restrict to sane characters
  3502.   # let use Math::BigInt lib => 'GMP'; use Math::BigFloat; still work
  3503.   my $mbilib = eval { Math::BigInt->config()->{lib} };
  3504.   if ((defined $mbilib) && ($MBI eq 'Math::BigInt::Calc'))
  3505.     {
  3506.     # MBI already loaded
  3507.     Math::BigInt->import( $lib_kind, "$lib,$mbilib", 'objectify');
  3508.     }
  3509.   else
  3510.     {
  3511.     # MBI not loaded, or with ne "Math::BigInt::Calc"
  3512.     $lib .= ",$mbilib" if defined $mbilib;
  3513.     $lib =~ s/^,//;                # don't leave empty 
  3514.     
  3515.     # replacement library can handle lib statement, but also could ignore it
  3516.     
  3517.     # Perl < 5.6.0 dies with "out of memory!" when eval() and ':constant' is
  3518.     # used in the same script, or eval inside import(). So we require MBI:
  3519.     require Math::BigInt;
  3520.     Math::BigInt->import( $lib_kind => $lib, 'objectify' );
  3521.     }
  3522.   if ($@)
  3523.     {
  3524.     require Carp; Carp::croak ("Couldn't load $lib: $! $@");
  3525.     }
  3526.   # find out which one was actually loaded
  3527.   $MBI = Math::BigInt->config()->{lib};
  3528.  
  3529.   # register us with MBI to get notified of future lib changes
  3530.   Math::BigInt::_register_callback( $self, sub { $MBI = $_[0]; } );
  3531.  
  3532.   $self->export_to_level(1,$self,@a);        # export wanted functions
  3533.   }
  3534.  
  3535. sub bnorm
  3536.   {
  3537.   # adjust m and e so that m is smallest possible
  3538.   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
  3539.  
  3540.   return $x if $x->{sign} !~ /^[+-]$/;        # inf, nan etc
  3541.  
  3542.   my $zeros = $MBI->_zeros($x->{_m});        # correct for trailing zeros
  3543.   if ($zeros != 0)
  3544.     {
  3545.     my $z = $MBI->_new($zeros);
  3546.     $x->{_m} = $MBI->_rsft ($x->{_m}, $z, 10);
  3547.     if ($x->{_es} eq '-')
  3548.       {
  3549.       if ($MBI->_acmp($x->{_e},$z) >= 0)
  3550.         {
  3551.         $x->{_e} = $MBI->_sub ($x->{_e}, $z);
  3552.         $x->{_es} = '+' if $MBI->_is_zero($x->{_e});
  3553.         }
  3554.       else
  3555.         {
  3556.         $x->{_e} = $MBI->_sub ( $MBI->_copy($z), $x->{_e});
  3557.         $x->{_es} = '+';
  3558.         }
  3559.       }
  3560.     else
  3561.       {
  3562.       $x->{_e} = $MBI->_add ($x->{_e}, $z);
  3563.       }
  3564.     }
  3565.   else
  3566.     {
  3567.     # $x can only be 0Ey if there are no trailing zeros ('0' has 0 trailing
  3568.     # zeros). So, for something like 0Ey, set y to 1, and -0 => +0
  3569.     $x->{sign} = '+', $x->{_es} = '+', $x->{_e} = $MBI->_one()
  3570.      if $MBI->_is_zero($x->{_m});
  3571.     }
  3572.  
  3573.   $x;                    # MBI bnorm is no-op, so dont call it
  3574.   } 
  3575.  
  3576. ##############################################################################
  3577.  
  3578. sub as_hex
  3579.   {
  3580.   # return number as hexadecimal string (only for integers defined)
  3581.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  3582.  
  3583.   return $x->bstr() if $x->{sign} !~ /^[+-]$/;  # inf, nan etc
  3584.   return '0x0' if $x->is_zero();
  3585.  
  3586.   return $nan if $x->{_es} ne '+';        # how to do 1e-1 in hex!?
  3587.  
  3588.   my $z = $MBI->_copy($x->{_m});
  3589.   if (! $MBI->_is_zero($x->{_e}))        # > 0 
  3590.     {
  3591.     $MBI->_lsft( $z, $x->{_e},10);
  3592.     }
  3593.   $z = Math::BigInt->new( $x->{sign} . $MBI->_num($z));
  3594.   $z->as_hex();
  3595.   }
  3596.  
  3597. sub as_bin
  3598.   {
  3599.   # return number as binary digit string (only for integers defined)
  3600.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  3601.  
  3602.   return $x->bstr() if $x->{sign} !~ /^[+-]$/;  # inf, nan etc
  3603.   return '0b0' if $x->is_zero();
  3604.  
  3605.   return $nan if $x->{_es} ne '+';        # how to do 1e-1 in hex!?
  3606.  
  3607.   my $z = $MBI->_copy($x->{_m});
  3608.   if (! $MBI->_is_zero($x->{_e}))        # > 0 
  3609.     {
  3610.     $MBI->_lsft( $z, $x->{_e},10);
  3611.     }
  3612.   $z = Math::BigInt->new( $x->{sign} . $MBI->_num($z));
  3613.   $z->as_bin();
  3614.   }
  3615.  
  3616. sub as_oct
  3617.   {
  3618.   # return number as octal digit string (only for integers defined)
  3619.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  3620.  
  3621.   return $x->bstr() if $x->{sign} !~ /^[+-]$/;  # inf, nan etc
  3622.   return '0' if $x->is_zero();
  3623.  
  3624.   return $nan if $x->{_es} ne '+';        # how to do 1e-1 in hex!?
  3625.  
  3626.   my $z = $MBI->_copy($x->{_m});
  3627.   if (! $MBI->_is_zero($x->{_e}))        # > 0 
  3628.     {
  3629.     $MBI->_lsft( $z, $x->{_e},10);
  3630.     }
  3631.   $z = Math::BigInt->new( $x->{sign} . $MBI->_num($z));
  3632.   $z->as_oct();
  3633.   }
  3634.  
  3635. sub as_number
  3636.   {
  3637.   # return copy as a bigint representation of this BigFloat number
  3638.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  3639.  
  3640.   return $x if $x->modify('as_number');
  3641.  
  3642.   my $z = $MBI->_copy($x->{_m});
  3643.   if ($x->{_es} eq '-')            # < 0
  3644.     {
  3645.     $MBI->_rsft( $z, $x->{_e},10);
  3646.     } 
  3647.   elsif (! $MBI->_is_zero($x->{_e}))    # > 0 
  3648.     {
  3649.     $MBI->_lsft( $z, $x->{_e},10);
  3650.     }
  3651.   $z = Math::BigInt->new( $x->{sign} . $MBI->_num($z));
  3652.   $z;
  3653.   }
  3654.  
  3655. sub length
  3656.   {
  3657.   my $x = shift;
  3658.   my $class = ref($x) || $x;
  3659.   $x = $class->new(shift) unless ref($x);
  3660.  
  3661.   return 1 if $MBI->_is_zero($x->{_m});
  3662.  
  3663.   my $len = $MBI->_len($x->{_m});
  3664.   $len += $MBI->_num($x->{_e}) if $x->{_es} eq '+';
  3665.   if (wantarray())
  3666.     {
  3667.     my $t = 0;
  3668.     $t = $MBI->_num($x->{_e}) if $x->{_es} eq '-';
  3669.     return ($len, $t);
  3670.     }
  3671.   $len;
  3672.   }
  3673.  
  3674. 1;
  3675. __END__
  3676.  
  3677. =head1 NAME
  3678.  
  3679. Math::BigFloat - Arbitrary size floating point math package
  3680.  
  3681. =head1 SYNOPSIS
  3682.  
  3683.   use Math::BigFloat;
  3684.  
  3685.   # Number creation
  3686.   my $x = Math::BigFloat->new($str);    # defaults to 0
  3687.   my $y = $x->copy();            # make a true copy
  3688.   my $nan  = Math::BigFloat->bnan();    # create a NotANumber
  3689.   my $zero = Math::BigFloat->bzero();    # create a +0
  3690.   my $inf = Math::BigFloat->binf();    # create a +inf
  3691.   my $inf = Math::BigFloat->binf('-');    # create a -inf
  3692.   my $one = Math::BigFloat->bone();    # create a +1
  3693.   my $mone = Math::BigFloat->bone('-');    # create a -1
  3694.  
  3695.   my $pi = Math::BigFloat->bpi(100);    # PI to 100 digits
  3696.  
  3697.   # the following examples compute their result to 100 digits accuracy:
  3698.   my $cos  = Math::BigFloat->new(1)->bcos(100);        # cosinus(1)
  3699.   my $sin  = Math::BigFloat->new(1)->bsin(100);        # sinus(1)
  3700.   my $atan = Math::BigFloat->new(1)->batan(100);    # arcus tangens(1)
  3701.  
  3702.   my $atan2 = Math::BigFloat->new(  1 )->batan2( 1 ,100); # batan(1)
  3703.   my $atan2 = Math::BigFloat->new(  1 )->batan2( 8 ,100); # batan(1/8)
  3704.   my $atan2 = Math::BigFloat->new( -2 )->batan2( 1 ,100); # batan(-2)
  3705.  
  3706.   # Testing
  3707.   $x->is_zero();        # true if arg is +0
  3708.   $x->is_nan();            # true if arg is NaN
  3709.   $x->is_one();            # true if arg is +1
  3710.   $x->is_one('-');        # true if arg is -1
  3711.   $x->is_odd();            # true if odd, false for even
  3712.   $x->is_even();        # true if even, false for odd
  3713.   $x->is_pos();            # true if >= 0
  3714.   $x->is_neg();            # true if <  0
  3715.   $x->is_inf(sign);        # true if +inf, or -inf (default is '+')
  3716.  
  3717.   $x->bcmp($y);            # compare numbers (undef,<0,=0,>0)
  3718.   $x->bacmp($y);        # compare absolutely (undef,<0,=0,>0)
  3719.   $x->sign();            # return the sign, either +,- or NaN
  3720.   $x->digit($n);        # return the nth digit, counting from right
  3721.   $x->digit(-$n);        # return the nth digit, counting from left 
  3722.  
  3723.   # The following all modify their first argument. If you want to preserve
  3724.   # $x, use $z = $x->copy()->bXXX($y); See under L<CAVEATS> for why this is
  3725.   # necessary when mixing $a = $b assignments with non-overloaded math.
  3726.  
  3727.   # set 
  3728.   $x->bzero();            # set $i to 0
  3729.   $x->bnan();            # set $i to NaN
  3730.   $x->bone();                   # set $x to +1
  3731.   $x->bone('-');                # set $x to -1
  3732.   $x->binf();                   # set $x to inf
  3733.   $x->binf('-');                # set $x to -inf
  3734.  
  3735.   $x->bneg();            # negation
  3736.   $x->babs();            # absolute value
  3737.   $x->bnorm();            # normalize (no-op)
  3738.   $x->bnot();            # two's complement (bit wise not)
  3739.   $x->binc();            # increment x by 1
  3740.   $x->bdec();            # decrement x by 1
  3741.   
  3742.   $x->badd($y);            # addition (add $y to $x)
  3743.   $x->bsub($y);            # subtraction (subtract $y from $x)
  3744.   $x->bmul($y);            # multiplication (multiply $x by $y)
  3745.   $x->bdiv($y);            # divide, set $x to quotient
  3746.                 # return (quo,rem) or quo if scalar
  3747.  
  3748.   $x->bmod($y);            # modulus ($x % $y)
  3749.   $x->bpow($y);            # power of arguments ($x ** $y)
  3750.   $x->bmodpow($exp,$mod);    # modular exponentation (($num**$exp) % $mod))
  3751.   $x->blsft($y, $n);        # left shift by $y places in base $n
  3752.   $x->brsft($y, $n);        # right shift by $y places in base $n
  3753.                 # returns (quo,rem) or quo if in scalar context
  3754.   
  3755.   $x->blog();            # logarithm of $x to base e (Euler's number)
  3756.   $x->blog($base);        # logarithm of $x to base $base (f.i. 2)
  3757.   $x->bexp();            # calculate e ** $x where e is Euler's number
  3758.   
  3759.   $x->band($y);            # bit-wise and
  3760.   $x->bior($y);            # bit-wise inclusive or
  3761.   $x->bxor($y);            # bit-wise exclusive or
  3762.   $x->bnot();            # bit-wise not (two's complement)
  3763.  
  3764.   $x->bsqrt();            # calculate square-root
  3765.   $x->broot($y);        # $y'th root of $x (e.g. $y == 3 => cubic root)
  3766.   $x->bfac();            # factorial of $x (1*2*3*4*..$x)
  3767.  
  3768.   $x->bround($N);         # accuracy: preserve $N digits
  3769.   $x->bfround($N);        # precision: round to the $Nth digit
  3770.  
  3771.   $x->bfloor();            # return integer less or equal than $x
  3772.   $x->bceil();            # return integer greater or equal than $x
  3773.  
  3774.   # The following do not modify their arguments:
  3775.  
  3776.   bgcd(@values);        # greatest common divisor
  3777.   blcm(@values);        # lowest common multiplicator
  3778.   
  3779.   $x->bstr();            # return string
  3780.   $x->bsstr();            # return string in scientific notation
  3781.  
  3782.   $x->as_int();            # return $x as BigInt 
  3783.   $x->exponent();        # return exponent as BigInt
  3784.   $x->mantissa();        # return mantissa as BigInt
  3785.   $x->parts();            # return (mantissa,exponent) as BigInt
  3786.  
  3787.   $x->length();            # number of digits (w/o sign and '.')
  3788.   ($l,$f) = $x->length();    # number of digits, and length of fraction    
  3789.  
  3790.   $x->precision();        # return P of $x (or global, if P of $x undef)
  3791.   $x->precision($n);        # set P of $x to $n
  3792.   $x->accuracy();        # return A of $x (or global, if A of $x undef)
  3793.   $x->accuracy($n);        # set A $x to $n
  3794.  
  3795.   # these get/set the appropriate global value for all BigFloat objects
  3796.   Math::BigFloat->precision();    # Precision
  3797.   Math::BigFloat->accuracy();    # Accuracy
  3798.   Math::BigFloat->round_mode();    # rounding mode
  3799.  
  3800. =head1 DESCRIPTION
  3801.  
  3802. All operators (including basic math operations) are overloaded if you
  3803. declare your big floating point numbers as
  3804.  
  3805.   $i = new Math::BigFloat '12_3.456_789_123_456_789E-2';
  3806.  
  3807. Operations with overloaded operators preserve the arguments, which is
  3808. exactly what you expect.
  3809.  
  3810. =head2 Canonical notation
  3811.  
  3812. Input to these routines are either BigFloat objects, or strings of the
  3813. following four forms:
  3814.  
  3815. =over 2
  3816.  
  3817. =item *
  3818.  
  3819. C</^[+-]\d+$/>
  3820.  
  3821. =item *
  3822.  
  3823. C</^[+-]\d+\.\d*$/>
  3824.  
  3825. =item *
  3826.  
  3827. C</^[+-]\d+E[+-]?\d+$/>
  3828.  
  3829. =item *
  3830.  
  3831. C</^[+-]\d*\.\d+E[+-]?\d+$/>
  3832.  
  3833. =back
  3834.  
  3835. all with optional leading and trailing zeros and/or spaces. Additionally,
  3836. numbers are allowed to have an underscore between any two digits.
  3837.  
  3838. Empty strings as well as other illegal numbers results in 'NaN'.
  3839.  
  3840. bnorm() on a BigFloat object is now effectively a no-op, since the numbers 
  3841. are always stored in normalized form. On a string, it creates a BigFloat 
  3842. object.
  3843.  
  3844. =head2 Output
  3845.  
  3846. Output values are BigFloat objects (normalized), except for bstr() and bsstr().
  3847.  
  3848. The string output will always have leading and trailing zeros stripped and drop
  3849. a plus sign. C<bstr()> will give you always the form with a decimal point,
  3850. while C<bsstr()> (s for scientific) gives you the scientific notation.
  3851.  
  3852.     Input            bstr()        bsstr()
  3853.     '-0'            '0'        '0E1'
  3854.        '  -123 123 123'    '-123123123'    '-123123123E0'
  3855.     '00.0123'        '0.0123'    '123E-4'
  3856.     '123.45E-2'        '1.2345'    '12345E-4'
  3857.     '10E+3'            '10000'        '1E4'
  3858.  
  3859. Some routines (C<is_odd()>, C<is_even()>, C<is_zero()>, C<is_one()>,
  3860. C<is_nan()>) return true or false, while others (C<bcmp()>, C<bacmp()>)
  3861. return either undef, <0, 0 or >0 and are suited for sort.
  3862.  
  3863. Actual math is done by using the class defined with C<with => Class;> (which
  3864. defaults to BigInts) to represent the mantissa and exponent.
  3865.  
  3866. The sign C</^[+-]$/> is stored separately. The string 'NaN' is used to 
  3867. represent the result when input arguments are not numbers, as well as 
  3868. the result of dividing by zero.
  3869.  
  3870. =head2 C<mantissa()>, C<exponent()> and C<parts()>
  3871.  
  3872. C<mantissa()> and C<exponent()> return the said parts of the BigFloat 
  3873. as BigInts such that:
  3874.  
  3875.     $m = $x->mantissa();
  3876.     $e = $x->exponent();
  3877.     $y = $m * ( 10 ** $e );
  3878.     print "ok\n" if $x == $y;
  3879.  
  3880. C<< ($m,$e) = $x->parts(); >> is just a shortcut giving you both of them.
  3881.  
  3882. A zero is represented and returned as C<0E1>, B<not> C<0E0> (after Knuth).
  3883.  
  3884. Currently the mantissa is reduced as much as possible, favouring higher
  3885. exponents over lower ones (e.g. returning 1e7 instead of 10e6 or 10000000e0).
  3886. This might change in the future, so do not depend on it.
  3887.  
  3888. =head2 Accuracy vs. Precision
  3889.  
  3890. See also: L<Rounding|Rounding>.
  3891.  
  3892. Math::BigFloat supports both precision (rounding to a certain place before or
  3893. after the dot) and accuracy (rounding to a certain number of digits). For a
  3894. full documentation, examples and tips on these topics please see the large
  3895. section about rounding in L<Math::BigInt>.
  3896.  
  3897. Since things like C<sqrt(2)> or C<1 / 3> must presented with a limited
  3898. accuracy lest a operation consumes all resources, each operation produces
  3899. no more than the requested number of digits.
  3900.  
  3901. If there is no gloabl precision or accuracy set, B<and> the operation in
  3902. question was not called with a requested precision or accuracy, B<and> the
  3903. input $x has no accuracy or precision set, then a fallback parameter will
  3904. be used. For historical reasons, it is called C<div_scale> and can be accessed
  3905. via:
  3906.  
  3907.     $d = Math::BigFloat->div_scale();        # query
  3908.     Math::BigFloat->div_scale($n);            # set to $n digits
  3909.  
  3910. The default value for C<div_scale> is 40.
  3911.  
  3912. In case the result of one operation has more digits than specified,
  3913. it is rounded. The rounding mode taken is either the default mode, or the one
  3914. supplied to the operation after the I<scale>:
  3915.  
  3916.     $x = Math::BigFloat->new(2);
  3917.     Math::BigFloat->accuracy(5);        # 5 digits max
  3918.     $y = $x->copy()->bdiv(3);        # will give 0.66667
  3919.     $y = $x->copy()->bdiv(3,6);        # will give 0.666667
  3920.     $y = $x->copy()->bdiv(3,6,undef,'odd');    # will give 0.666667
  3921.     Math::BigFloat->round_mode('zero');
  3922.     $y = $x->copy()->bdiv(3,6);        # will also give 0.666667
  3923.  
  3924. Note that C<< Math::BigFloat->accuracy() >> and C<< Math::BigFloat->precision() >>
  3925. set the global variables, and thus B<any> newly created number will be subject
  3926. to the global rounding B<immediately>. This means that in the examples above, the
  3927. C<3> as argument to C<bdiv()> will also get an accuracy of B<5>.
  3928.  
  3929. It is less confusing to either calculate the result fully, and afterwards
  3930. round it explicitly, or use the additional parameters to the math
  3931. functions like so:
  3932.  
  3933.     use Math::BigFloat;    
  3934.     $x = Math::BigFloat->new(2);
  3935.     $y = $x->copy()->bdiv(3);
  3936.     print $y->bround(5),"\n";        # will give 0.66667
  3937.  
  3938.     or
  3939.  
  3940.     use Math::BigFloat;    
  3941.     $x = Math::BigFloat->new(2);
  3942.     $y = $x->copy()->bdiv(3,5);        # will give 0.66667
  3943.     print "$y\n";
  3944.  
  3945. =head2 Rounding
  3946.  
  3947. =over 2
  3948.  
  3949. =item ffround ( +$scale )
  3950.  
  3951. Rounds to the $scale'th place left from the '.', counting from the dot.
  3952. The first digit is numbered 1. 
  3953.  
  3954. =item ffround ( -$scale )
  3955.  
  3956. Rounds to the $scale'th place right from the '.', counting from the dot.
  3957.  
  3958. =item ffround ( 0 )
  3959.  
  3960. Rounds to an integer.
  3961.  
  3962. =item fround  ( +$scale )
  3963.  
  3964. Preserves accuracy to $scale digits from the left (aka significant digits)
  3965. and pads the rest with zeros. If the number is between 1 and -1, the
  3966. significant digits count from the first non-zero after the '.'
  3967.  
  3968. =item fround  ( -$scale ) and fround ( 0 )
  3969.  
  3970. These are effectively no-ops.
  3971.  
  3972. =back
  3973.  
  3974. All rounding functions take as a second parameter a rounding mode from one of
  3975. the following: 'even', 'odd', '+inf', '-inf', 'zero', 'trunc' or 'common'.
  3976.  
  3977. The default rounding mode is 'even'. By using
  3978. C<< Math::BigFloat->round_mode($round_mode); >> you can get and set the default
  3979. mode for subsequent rounding. The usage of C<$Math::BigFloat::$round_mode> is
  3980. no longer supported.
  3981. The second parameter to the round functions then overrides the default
  3982. temporarily. 
  3983.  
  3984. The C<as_number()> function returns a BigInt from a Math::BigFloat. It uses
  3985. 'trunc' as rounding mode to make it equivalent to:
  3986.  
  3987.     $x = 2.5;
  3988.     $y = int($x) + 2;
  3989.  
  3990. You can override this by passing the desired rounding mode as parameter to
  3991. C<as_number()>:
  3992.  
  3993.     $x = Math::BigFloat->new(2.5);
  3994.     $y = $x->as_number('odd');    # $y = 3
  3995.  
  3996. =head1 METHODS
  3997.  
  3998. Math::BigFloat supports all methods that Math::BigInt supports, except it
  3999. calculates non-integer results when possible. Please see L<Math::BigInt>
  4000. for a full description of each method. Below are just the most important
  4001. differences:
  4002.  
  4003. =head2 accuracy
  4004.  
  4005.         $x->accuracy(5);                # local for $x
  4006.         CLASS->accuracy(5);             # global for all members of CLASS
  4007.                                         # Note: This also applies to new()!
  4008.  
  4009.         $A = $x->accuracy();            # read out accuracy that affects $x
  4010.         $A = CLASS->accuracy();         # read out global accuracy
  4011.  
  4012. Set or get the global or local accuracy, aka how many significant digits the
  4013. results have. If you set a global accuracy, then this also applies to new()!
  4014.  
  4015. Warning! The accuracy I<sticks>, e.g. once you created a number under the
  4016. influence of C<< CLASS->accuracy($A) >>, all results from math operations with
  4017. that number will also be rounded.
  4018.  
  4019. In most cases, you should probably round the results explicitly using one of
  4020. L<round()>, L<bround()> or L<bfround()> or by passing the desired accuracy
  4021. to the math operation as additional parameter:
  4022.  
  4023.         my $x = Math::BigInt->new(30000);
  4024.         my $y = Math::BigInt->new(7);
  4025.         print scalar $x->copy()->bdiv($y, 2);           # print 4300
  4026.         print scalar $x->copy()->bdiv($y)->bround(2);   # print 4300
  4027.  
  4028. =head2 precision()
  4029.  
  4030.         $x->precision(-2);      # local for $x, round at the second digit right of the dot
  4031.         $x->precision(2);       # ditto, round at the second digit left of the dot
  4032.  
  4033.         CLASS->precision(5);    # Global for all members of CLASS
  4034.                                 # This also applies to new()!
  4035.         CLASS->precision(-5);   # ditto
  4036.  
  4037.         $P = CLASS->precision();        # read out global precision
  4038.         $P = $x->precision();           # read out precision that affects $x
  4039.  
  4040. Note: You probably want to use L<accuracy()> instead. With L<accuracy> you
  4041. set the number of digits each result should have, with L<precision> you
  4042. set the place where to round!
  4043.  
  4044. =head2 bexp()
  4045.  
  4046.     $x->bexp($accuracy);        # calculate e ** X
  4047.  
  4048. Calculates the expression C<e ** $x> where C<e> is Euler's number.
  4049.  
  4050. This method was added in v1.82 of Math::BigInt (April 2007).
  4051.  
  4052. =head2 bnok()
  4053.  
  4054.     $x->bnok($y);           # x over y (binomial coefficient n over k)
  4055.  
  4056. Calculates the binomial coefficient n over k, also called the "choose"
  4057. function. The result is equivalent to:
  4058.  
  4059.     ( n )      n!
  4060.     | - |  = -------
  4061.     ( k )    k!(n-k)!
  4062.  
  4063. This method was added in v1.84 of Math::BigInt (April 2007).
  4064.  
  4065. =head2 bpi()
  4066.  
  4067.     print Math::BigFloat->bpi(100), "\n";
  4068.  
  4069. Calculate PI to N digits (including the 3 before the dot). The result is
  4070. rounded according to the current rounding mode, which defaults to "even".
  4071.  
  4072. This method was added in v1.87 of Math::BigInt (June 2007).
  4073.  
  4074. =head2 bcos()
  4075.  
  4076.     my $x = Math::BigFloat->new(1);
  4077.     print $x->bcos(100), "\n";
  4078.  
  4079. Calculate the cosinus of $x, modifying $x in place.
  4080.  
  4081. This method was added in v1.87 of Math::BigInt (June 2007).
  4082.  
  4083. =head2 bsin()
  4084.  
  4085.     my $x = Math::BigFloat->new(1);
  4086.     print $x->bsin(100), "\n";
  4087.  
  4088. Calculate the sinus of $x, modifying $x in place.
  4089.  
  4090. This method was added in v1.87 of Math::BigInt (June 2007).
  4091.  
  4092. =head2 batan2()
  4093.  
  4094.     my $y = Math::BigFloat->new(2);
  4095.     my $x = Math::BigFloat->new(3);
  4096.     print $y->batan2($x), "\n";
  4097.  
  4098. Calculate the arcus tanges of C<$y> divided by C<$x>, modifying $y in place.
  4099. See also L<batan()>.
  4100.  
  4101. This method was added in v1.87 of Math::BigInt (June 2007).
  4102.  
  4103. =head2 batan()
  4104.  
  4105.     my $x = Math::BigFloat->new(1);
  4106.     print $x->batan(100), "\n";
  4107.  
  4108. Calculate the arcus tanges of $x, modifying $x in place. See also L<batan2()>.
  4109.  
  4110. This method was added in v1.87 of Math::BigInt (June 2007).
  4111.  
  4112. =head2 bmuladd()
  4113.  
  4114.     $x->bmuladd($y,$z);        
  4115.  
  4116. Multiply $x by $y, and then add $z to the result.
  4117.  
  4118. This method was added in v1.87 of Math::BigInt (June 2007).
  4119.  
  4120. =head1 Autocreating constants
  4121.  
  4122. After C<use Math::BigFloat ':constant'> all the floating point constants
  4123. in the given scope are converted to C<Math::BigFloat>. This conversion
  4124. happens at compile time.
  4125.  
  4126. In particular
  4127.  
  4128.   perl -MMath::BigFloat=:constant -e 'print 2E-100,"\n"'
  4129.  
  4130. prints the value of C<2E-100>. Note that without conversion of 
  4131. constants the expression 2E-100 will be calculated as normal floating point 
  4132. number.
  4133.  
  4134. Please note that ':constant' does not affect integer constants, nor binary 
  4135. nor hexadecimal constants. Use L<bignum> or L<Math::BigInt> to get this to
  4136. work.
  4137.  
  4138. =head2 Math library
  4139.  
  4140. Math with the numbers is done (by default) by a module called
  4141. Math::BigInt::Calc. This is equivalent to saying:
  4142.  
  4143.     use Math::BigFloat lib => 'Calc';
  4144.  
  4145. You can change this by using:
  4146.  
  4147.     use Math::BigFloat lib => 'GMP';
  4148.  
  4149. Note: The keyword 'lib' will warn when the requested library could not be
  4150. loaded. To suppress the warning use 'try' instead:
  4151.  
  4152.     use Math::BigFloat try => 'GMP';
  4153.  
  4154. To turn the warning into a die(), use 'only' instead:
  4155.  
  4156.     use Math::BigFloat only => 'GMP';
  4157.  
  4158. The following would first try to find Math::BigInt::Foo, then
  4159. Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc:
  4160.  
  4161.     use Math::BigFloat lib => 'Foo,Math::BigInt::Bar';
  4162.  
  4163. See the respective low-level library documentation for further details.
  4164.  
  4165. Please note that Math::BigFloat does B<not> use the denoted library itself,
  4166. but it merely passes the lib argument to Math::BigInt. So, instead of the need
  4167. to do:
  4168.  
  4169.     use Math::BigInt lib => 'GMP';
  4170.     use Math::BigFloat;
  4171.  
  4172. you can roll it all into one line:
  4173.  
  4174.     use Math::BigFloat lib => 'GMP';
  4175.  
  4176. It is also possible to just require Math::BigFloat:
  4177.  
  4178.     require Math::BigFloat;
  4179.  
  4180. This will load the necessary things (like BigInt) when they are needed, and
  4181. automatically.
  4182.  
  4183. See L<Math::BigInt> for more details than you ever wanted to know about using
  4184. a different low-level library.
  4185.  
  4186. =head2 Using Math::BigInt::Lite
  4187.  
  4188. For backwards compatibility reasons it is still possible to
  4189. request a different storage class for use with Math::BigFloat:
  4190.  
  4191.         use Math::BigFloat with => 'Math::BigInt::Lite';
  4192.  
  4193. However, this request is ignored, as the current code now uses the low-level
  4194. math libary for directly storing the number parts.
  4195.  
  4196. =head1 EXPORTS
  4197.  
  4198. C<Math::BigFloat> exports nothing by default, but can export the C<bpi()> method:
  4199.  
  4200.     use Math::BigFloat qw/bpi/;
  4201.  
  4202.     print bpi(10), "\n";
  4203.  
  4204. =head1 BUGS
  4205.  
  4206. Please see the file BUGS in the CPAN distribution Math::BigInt for known bugs.
  4207.  
  4208. =head1 CAVEATS
  4209.  
  4210. Do not try to be clever to insert some operations in between switching
  4211. libraries:
  4212.  
  4213.     require Math::BigFloat;
  4214.     my $matter = Math::BigFloat->bone() + 4;    # load BigInt and Calc
  4215.     Math::BigFloat->import( lib => 'Pari' );    # load Pari, too
  4216.     my $anti_matter = Math::BigFloat->bone()+4;    # now use Pari
  4217.  
  4218. This will create objects with numbers stored in two different backend libraries,
  4219. and B<VERY BAD THINGS> will happen when you use these together:
  4220.  
  4221.     my $flash_and_bang = $matter + $anti_matter;    # Don't do this!
  4222.  
  4223. =over 1
  4224.  
  4225. =item stringify, bstr()
  4226.  
  4227. Both stringify and bstr() now drop the leading '+'. The old code would return
  4228. '+1.23', the new returns '1.23'. See the documentation in L<Math::BigInt> for
  4229. reasoning and details.
  4230.  
  4231. =item bdiv
  4232.  
  4233. The following will probably not print what you expect:
  4234.  
  4235.     print $c->bdiv(123.456),"\n";
  4236.  
  4237. It prints both quotient and reminder since print works in list context. Also,
  4238. bdiv() will modify $c, so be careful. You probably want to use
  4239.     
  4240.     print $c / 123.456,"\n";
  4241.     print scalar $c->bdiv(123.456),"\n";  # or if you want to modify $c
  4242.  
  4243. instead.
  4244.  
  4245. =item brsft
  4246.  
  4247. The following will probably not print what you expect:
  4248.  
  4249.     my $c = Math::BigFloat->new('3.14159');
  4250.         print $c->brsft(3,10),"\n";    # prints 0.00314153.1415
  4251.  
  4252. It prints both quotient and remainder, since print calls C<brsft()> in list
  4253. context. Also, C<< $c->brsft() >> will modify $c, so be careful.
  4254. You probably want to use
  4255.  
  4256.     print scalar $c->copy()->brsft(3,10),"\n";
  4257.     # or if you really want to modify $c
  4258.         print scalar $c->brsft(3,10),"\n";
  4259.  
  4260. instead.
  4261.  
  4262. =item Modifying and =
  4263.  
  4264. Beware of:
  4265.  
  4266.     $x = Math::BigFloat->new(5);
  4267.     $y = $x;
  4268.  
  4269. It will not do what you think, e.g. making a copy of $x. Instead it just makes
  4270. a second reference to the B<same> object and stores it in $y. Thus anything
  4271. that modifies $x will modify $y (except overloaded math operators), and vice
  4272. versa. See L<Math::BigInt> for details and how to avoid that.
  4273.  
  4274. =item bpow
  4275.  
  4276. C<bpow()> now modifies the first argument, unlike the old code which left
  4277. it alone and only returned the result. This is to be consistent with
  4278. C<badd()> etc. The first will modify $x, the second one won't:
  4279.  
  4280.     print bpow($x,$i),"\n";     # modify $x
  4281.     print $x->bpow($i),"\n";     # ditto
  4282.     print $x ** $i,"\n";        # leave $x alone 
  4283.  
  4284. =item precision() vs. accuracy()
  4285.  
  4286. A common pitfall is to use L<precision()> when you want to round a result to
  4287. a certain number of digits:
  4288.  
  4289.     use Math::BigFloat;
  4290.  
  4291.     Math::BigFloat->precision(4);        # does not do what you think it does
  4292.     my $x = Math::BigFloat->new(12345);    # rounds $x to "12000"!
  4293.     print "$x\n";                # print "12000"
  4294.     my $y = Math::BigFloat->new(3);        # rounds $y to "0"!
  4295.     print "$y\n";                # print "0"
  4296.     $z = $x / $y;                # 12000 / 0 => NaN!
  4297.     print "$z\n";
  4298.     print $z->precision(),"\n";        # 4
  4299.  
  4300. Replacing L<precision> with L<accuracy> is probably not what you want, either:
  4301.  
  4302.     use Math::BigFloat;
  4303.  
  4304.     Math::BigFloat->accuracy(4);        # enables global rounding:
  4305.     my $x = Math::BigFloat->new(123456);    # rounded immediately to "12350"
  4306.     print "$x\n";                # print "123500"
  4307.     my $y = Math::BigFloat->new(3);        # rounded to "3
  4308.     print "$y\n";                # print "3"
  4309.     print $z = $x->copy()->bdiv($y),"\n";    # 41170
  4310.     print $z->accuracy(),"\n";        # 4
  4311.  
  4312. What you want to use instead is:
  4313.  
  4314.     use Math::BigFloat;
  4315.  
  4316.     my $x = Math::BigFloat->new(123456);    # no rounding
  4317.     print "$x\n";                # print "123456"
  4318.     my $y = Math::BigFloat->new(3);        # no rounding
  4319.     print "$y\n";                # print "3"
  4320.     print $z = $x->copy()->bdiv($y,4),"\n";    # 41150
  4321.     print $z->accuracy(),"\n";        # undef
  4322.  
  4323. In addition to computing what you expected, the last example also does B<not>
  4324. "taint" the result with an accuracy or precision setting, which would
  4325. influence any further operation.
  4326.  
  4327. =back
  4328.  
  4329. =head1 SEE ALSO
  4330.  
  4331. L<Math::BigInt>, L<Math::BigRat> and L<Math::Big> as well as
  4332. L<Math::BigInt::BitVect>, L<Math::BigInt::Pari> and  L<Math::BigInt::GMP>.
  4333.  
  4334. The pragmas L<bignum>, L<bigint> and L<bigrat> might also be of interest
  4335. because they solve the autoupgrading/downgrading issue, at least partly.
  4336.  
  4337. The package at L<http://search.cpan.org/~tels/Math-BigInt> contains
  4338. more documentation including a full version history, testcases, empty
  4339. subclass files and benchmarks.
  4340.  
  4341. =head1 LICENSE
  4342.  
  4343. This program is free software; you may redistribute it and/or modify it under
  4344. the same terms as Perl itself.
  4345.  
  4346. =head1 AUTHORS
  4347.  
  4348. Mark Biggar, overloaded interface by Ilya Zakharevich.
  4349. Completely rewritten by Tels L<http://bloodgate.com> in 2001 - 2006, and still
  4350. at it in 2007.
  4351.  
  4352. =cut
  4353.